home *** CD-ROM | disk | FTP | other *** search
/ Delphi 5 for Professionals / DELPHI5.iso / AddOns / Components / Orpheus v3.02 / SETUP.EXE / %MAINDIR% / OvcCalc.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-02-25  |  74.8 KB  |  2,658 lines
  1. {*********************************************************}
  2. {*                   OVCCALC.PAS 3.00                    *}
  3. {*     Copyright 1995-99 (c) TurboPower Software Co      *}
  4. {*                 All rights reserved.                  *}
  5. {*********************************************************}
  6.  
  7. {$I OVC.INC}
  8.  
  9. {$B-} {Complete Boolean Evaluation}
  10. {$I+} {Input/Output-Checking}
  11. {$P+} {Open Parameters}
  12. {$T-} {Typed @ Operator}
  13. {$W-} {Windows Stack Frame}
  14. {$X+} {Extended Syntax}
  15.  
  16. {$IFNDEF Win32}
  17. {$G+} {286 Instructions}
  18. {$N+} {Numeric Coprocessor}
  19.  
  20. {$C MOVEABLE,DEMANDLOAD,DISCARDABLE}
  21. {$ENDIF}
  22.  
  23. unit OvcCalc;
  24.   {-calculator component}
  25.  
  26. interface
  27.  
  28. uses
  29.   {$IFDEF Win32} Windows, {$ELSE} WinTypes, WinProcs, {$ENDIF}
  30.   Buttons, Classes, ClipBrd, Controls, ExtCtrls, Forms, Graphics,
  31.   Menus, Messages, StdCtrls, SysUtils,
  32.   OvcData, OvcConst, OvcBase, OvcMisc, OvcStr;
  33.  
  34. type
  35.   TOvcCalculatorButton = (
  36.     cbNone, cbTape, cbBack, cbClearEntry, cbClear, cbAdd, cbSub, cbMul, cbDiv,
  37.     cb0, cb1, cb2, cb3, cb4, cb5,  cb6, cb7, cb8, cb9,
  38.     cbDecimal, cbEqual, cbInvert, cbChangeSign, cbPercent, cbSqrt,
  39.     cbMemClear, cbMemRecall, cbMemStore, cbMemAdd, cbMemSub, cbSubTotal);
  40.  
  41.   TOvcButtonInfo = packed record
  42.     Position : TRect;      {position and size}
  43.     Caption  : string[10]; {button text}
  44.     Visible  : Boolean;    {true to display button}
  45.   end;
  46.  
  47.   TOvcButtonArray = array[cbTape..cbMemSub] of TOvcButtonInfo;
  48.  
  49. type
  50.   TOvcCalculatorOperation = (
  51.     coNone, coAdd, coSub, coMul, coDiv,
  52.     coEqual, coInvert, coPercent, coSqrt,
  53.     coMemClear, coMemRecall, coMemStore, coMemAdd, coMemSub, coSubTotal);
  54.  
  55.   TOvcCalcState = (csValid, csLocked, csClear);
  56.   TOvcCalcStates = set of TOvcCalcState;
  57.  
  58. type
  59.   TOvcCalcColorArray = array[0..7] of TColor;
  60.   TOvcCalcColorScheme = (cscalcCustom, cscalcWindows, cscalcDark,
  61.                         cscalcOcean, cscalcPlain);
  62.   TOvcCalcSchemeArray = array[TOvcCalcColorScheme] of TOvcCalcColorArray;
  63.   TOvcCalcDisplayString = array[TOvcCalculatorButton] of string;
  64.   TOvcCalcButtonToOperation = array[cbNone..cbSubTotal] of TOvcCalculatorOperation;
  65.  
  66.  
  67. const
  68.   {DisabledMemoryButtons, Display, DisplayTextColor, EditButtons,
  69.    FunctionButtons, MemoryButtons, NumberButtons, OperatorButtons}
  70.   CalcScheme : TOvcCalcSchemeArray =
  71.     ((0, 0, 0, 0, 0, 0, 0, 0),
  72.      (clGray, clWindow, clWindowText, clMaroon, clNavy, clRed,  clBlue,   clRed),
  73.      (clGray, clBlack,  clAqua,       clBlack,  clTeal, clNavy, clMaroon, clBlue),
  74.      (clGray, clAqua,   clBlack,      clPurple, clNavy, clNavy, clAqua,   clBlue),
  75.      (clGray, clWhite,  clNavy,       clBlack,  clNavy, clNavy, clBlue,   clBlue)
  76.     );
  77. { You must set the Length of the first entry (cbNone) to the Length of the largest entry}
  78.   CalcDisplayString : TOvcCalcDisplayString =
  79.     ('  ','  ','  ','CE','C' ,'+' ,'-' ,'*' ,'/',
  80.      '  ','  ','  ','  ','  ','  ','  ','  ','  ','  ',
  81.      '  ','=' ,'1/','-+','%' ,'SQ',
  82.      'MC','MR','MS','M+','M-','*' );
  83.  
  84.   CalcButtontoOperation : TOvcCalcButtonToOperation =
  85.     (coNone, coNone, coNone, coNone, coNone, coAdd, coSub, coMul, coDiv,
  86.      coNone, coNone, coNone, coNone, coNone, coNone,  coNone, coNone, coNone, coNone,
  87.      coNone, coEqual, coInvert, coNone, coPercent, coSqrt,
  88.      coMemClear, coMemRecall, coMemStore, coMemAdd, coMemSub, coSubTotal);
  89.  
  90. type
  91.   TOvcCalcColors = class(TPersistent)
  92.   {.Z+}
  93.   private
  94.     {property variables}
  95.     FUpdating     : Boolean;
  96.     FOnChange     : TNotifyEvent;
  97.  
  98.     {internal variables}
  99.     SettingScheme : Boolean;
  100.  
  101.     {internal methods}
  102.     procedure DoOnChange;
  103.  
  104.     {property methods}
  105.     function GetColor(const Index : Integer) : TColor;
  106.     procedure SetColor(const Index : Integer; const Value : TColor);
  107.     procedure SetColorScheme(const Value : TOvcCalcColorScheme);
  108.     procedure SetDisplayTextColor(const Value : TColor);
  109.  
  110.   public
  111.     {property variables}
  112.     FCalcColors   : TOvcCalcColorArray;
  113.     FColorScheme  : TOvcCalcColorScheme;
  114.  
  115.     procedure Assign(Source : TPersistent);
  116.       override;
  117.     procedure BeginUpdate;
  118.     procedure EndUpdate;
  119.  
  120.     property OnChange : TNotifyEvent
  121.       read FOnChange write FOnChange;
  122.   {.Z-}
  123.  
  124.   published
  125.     property ColorScheme : TOvcCalcColorScheme
  126.       read FColorScheme write SetColorScheme;
  127.     property DisabledMemoryButtons : TColor index 0
  128.       read GetColor write SetColor;
  129.     property Display : TColor index 1
  130.       read GetColor write SetColor;
  131.     property DisplayTextColor : TColor
  132.       read FCalcColors[2] write SetDisplayTextColor nodefault;
  133.     property EditButtons : TColor index 3
  134.       read GetColor write SetColor;
  135.     property FunctionButtons : TColor index 4
  136.       read GetColor write SetColor;
  137.     property MemoryButtons : TColor index 5
  138.       read GetColor write SetColor;
  139.     property NumberButtons : TColor index 6
  140.       read GetColor write SetColor;
  141.     property OperatorButtons : TColor index 7
  142.       read GetColor write SetColor;
  143.   end;
  144.  
  145. type
  146.   {.Z+}
  147.   TOvcCalcPanel = class(TPanel)
  148.   protected
  149.     procedure Click;
  150.       override;
  151.   public
  152.   end;
  153.   {.Z-}
  154.  
  155. type
  156.   {.Z+}
  157.   TOvcCustomCalculatorEngine = class
  158.   protected {private}
  159.     {property variables}
  160.     FDecimals            : Integer;
  161.     FShowSeparatePercent : Boolean;
  162.  
  163.     {internal variables}
  164.     cCalculated          : Extended;
  165.     cLastOperation       : TOvcCalculatorOperation;
  166.     cOperationCount      : Integer;
  167.     cMemory              : Extended;     {value stored in memory register}
  168.     cOperands            : array [0..3] of Extended;     {the operand stack}
  169.     cState               : TOvcCalcStates;
  170.  
  171.   public
  172.     function AddOperand(const Value : Extended; const Button : TOvcCalculatorOperation) : Boolean;
  173.         virtual; abstract;
  174.     function AddOperation(const Button : TOvcCalculatorOperation) : Boolean;
  175.         virtual; abstract;
  176.     procedure ClearAll;
  177.     procedure PushOperand(const Value : Extended);
  178.     function PopOperand : Extended;
  179.     function TopOperand : Extended;
  180.  
  181.     {public properties}
  182.     property Decimals : Integer
  183.       read FDecimals write FDecimals;
  184.     property LastOperation : TOvcCalculatorOperation
  185.       read cLastOperation write cLastOperation;
  186.     property Memory : Extended
  187.       read cMemory write cMemory;
  188.     property OperationCount : Integer
  189.       read cOperationCount write cOperationCount;
  190.     property ShowSeparatePercent : Boolean
  191.       read FShowSeparatePercent write FShowSeparatePercent;
  192.     property State : TOvcCalcStates
  193.       read cState write cState;
  194.   end;
  195.   {.Z-}
  196.  
  197. type
  198.   {.Z+}
  199.   TOvcCalcTape = class(TObject)
  200.   protected {private}
  201.     {property variables}
  202.     FMaxPaperCount    : Integer;
  203.     FShowTape         : Boolean;
  204.     FTapeDisplaySpace : Integer;
  205.     FVisible          : Boolean;
  206.  
  207.     {internal variables}
  208.     taListBox         : TListBox;
  209.     taTapeColor       : TColor;
  210.     taHeight          : Integer;
  211.     taOwner           : TComponent;
  212.     taOperandSize     : Integer;
  213.     taFont            : TFont;
  214.     taMaxTapeCount    : Integer;
  215.     taTapeInitialized : Boolean;
  216.     taWidth           : Integer;
  217.  
  218.     procedure ValidateListBox;
  219.     function GetFont : TFont;
  220.     procedure SetFont(const Value : TFont);
  221.     function GetHeight : Integer;
  222.     procedure SetHeight(const Value : Integer);
  223.     function GetTape : TStrings;
  224.     procedure SetTape(const Value : TStrings);
  225.     function GetTapeColor : TColor;
  226.     procedure SetTapeColor(const Value : TColor);
  227.     function GetTop : Integer;
  228.     procedure SetTop(const Value : Integer);
  229.     function GetTopIndex : Integer;
  230.     procedure SetTopIndex(const Value : Integer);
  231.     function GetVisible : Boolean;
  232.     procedure SetVisible(const Value : Boolean);
  233.     function GetWidth : Integer;
  234.     procedure SetWidth(const Value : Integer);
  235.  
  236.   protected
  237.     procedure Add(const Value : string);
  238.     procedure DeleteFirst;
  239.     procedure taOnClick(Sender : TObject);
  240.     procedure taOnDblClick(Sender : TObject);
  241.     procedure taOnDrawItem(Control: TWinControl; Index: Integer;
  242.                            Rect:TRect;State: TOwnerDrawState);
  243.     procedure taTapeFontChange(Sender : TObject);
  244.  
  245.   public
  246.     constructor Create(const AOwner : TComponent; const AOperandSize : Integer);
  247.     destructor Destroy;
  248.       override;
  249.  
  250.     procedure InitializeTape;
  251.     procedure SetBounds(const ALeft, ATop, AWidth, AHeight : Integer);
  252.     function GetDisplayedItemCount : Integer;
  253.     procedure AddToTape(const Value : string;
  254.                          OpString : string);
  255.     procedure AddToTapeLeft(const Value : string);
  256.     procedure ClearTape;
  257.     procedure RefreshDisplays;
  258.     procedure SpaceTape(const Value : char);
  259.  
  260.     property Font : TFont
  261.       read GetFont write SetFont;
  262.     property Height : Integer
  263.       read GetHeight write SetHeight;
  264.     property MaxPaperCount : Integer
  265.       read FMaxPaperCount write FMaxPaperCount;
  266.     property ShowTape : Boolean
  267.       read FShowTape write FShowTape;
  268.     property Tape : TStrings
  269.       read GetTape write SetTape;
  270.     property TapeColor : TColor
  271.       read GetTapeColor write SetTapeColor;
  272.     property TapeDisplaySpace : Integer
  273.       read FTapeDisplaySpace write FTapeDisplaySpace;
  274.     property Top : Integer
  275.       read GetTop write SetTop;
  276.     property TopIndex : Integer
  277.       read GetTopIndex write SetTopIndex;
  278.     property Visible : Boolean
  279.       read GetVisible write SetVisible;
  280.     property Width : Integer
  281.       read GetWidth write SetWidth;
  282.   end;
  283.   {.Z-}
  284.  
  285. type
  286.   TOvcCalcButtonPressedEvent =
  287.     procedure(Sender : TObject; Button : TOvcCalculatorButton)
  288.     of object;
  289.  
  290.   TOvcCalculatorOption = (coShowItemCount, coShowMemoryButtons,
  291.     coShowClearTapeButton, coShowTape, coShowSeparatePercent);
  292.   TOvcCalculatorOptions = set of TOvcCalculatorOption;
  293.  
  294.   TOvcCustomCalculator = class(TOvcCustomControl)
  295.   {.Z+}
  296.   protected {private}
  297.     {property variables}
  298.     FBorderStyle       : TBorderStyle;
  299.     FColors            : TOvcCalcColors;
  300.     FDisplay           : Extended;     {the calculated value}
  301.     FDisplayStr        : string;       {the string that is displayed}
  302.     FLastOperand       : Extended;
  303.     FOptions           : TOvcCalculatorOptions;
  304.     FTapeSeparatorChar : Char;
  305.  
  306.     {event variables}
  307.     FOnButtonPressed   : TOvcCalcButtonPressedEvent;
  308.  
  309.     {internal variables}
  310.     cButtons           : TOvcButtonArray;
  311.     cDecimalEntered    : Boolean;
  312.     cDownButton        : TOvcCalculatorButton;
  313.     cHitTest           : TPoint;       {location of mouse cursor}
  314.     cLastButton        : TOvcCalculatorButton;
  315.     cMargin            : Integer;
  316.     cMinus0            : Boolean;
  317.     cOverBar           : Boolean;
  318.     cPanel             : TOvcCalcPanel;
  319.     cPopup             : Boolean;      {true if being created as a popup}
  320.     cScrBarWidth       : Integer;
  321.     cSizeOffset        : Integer;      { the offset of the sizing line }
  322.     cSizing            : Boolean;      { Are we showing the sizing cursor? }
  323.     cTabCursor         : HCursor;      {design-time tab slecting cursor handle}
  324.     cTape              : TOvcCalcTape;
  325.     cEngine            : TOvcCustomCalculatorEngine;
  326.  
  327.     {internal methods}
  328.     procedure cAdjustHeight;
  329.     procedure cCalculateLook;
  330.     procedure cClearAll;
  331.     procedure cColorChange(Sender : TObject);
  332.     procedure cDisplayError;
  333.     procedure cDrawCalcButton(const Button : TOvcButtonInfo; const Pressed : Boolean);
  334.     procedure cDrawFocusState;
  335.     procedure cDrawSizeLine;
  336.     procedure cEvaluate(const Button : TOvcCalculatorButton);
  337.     function cFormatString(const Value : Extended) : string;
  338.     function cGetFontWidth : Integer;
  339.     procedure cInvalidateIndicator;
  340.     procedure cRefreshDisplays;
  341.     procedure cSetDisplayString(const Value : string);
  342.     procedure cTapeFontChange(Sender : TObject);
  343.  
  344.     {property methods}
  345.     function GetDecimals : Integer;
  346.     function GetMaxPaperCount : Integer;
  347.     function GetMemory : Extended;
  348.     function GetOperand : Extended;
  349.     function GetTape : TStrings;
  350.     function GetTapeFont : TFont;
  351.     function GetTapeHeight : Integer;
  352.     function GetVisible : Boolean;
  353.     procedure SetBorderStyle(const Value : TBorderStyle);
  354.     procedure SetDecimals(const Value : Integer);
  355.     procedure SetDisplay(const Value : Extended);
  356.     procedure SetDisplayStr(const Value : string);
  357.     procedure SetMaxPaperCount(const Value : Integer);
  358.     procedure SetMemory(const Value : Extended);
  359.     procedure SetOperand(const Value : Extended);
  360.     procedure SetOptions(const Value : TOvcCalculatorOptions);
  361.     procedure SetTape(const Value : TStrings);
  362.     procedure SetTapeFont(const Value : TFont);
  363.     procedure SetTapeHeight(const Value : Integer);
  364.     procedure SetVisible(const Value : Boolean);
  365.  
  366.     {VCL control methods}
  367.     procedure CMCtl3DChanged(var Msg : TMessage);
  368.       message CM_CTL3DCHANGED;
  369.     procedure CMDesignHitTest(var Msg : TCMDesignHitTest);
  370.       message CM_DESIGNHITTEST;
  371.     procedure CMEnter(var Msg : TMessage);
  372.       message CM_ENTER;
  373.     procedure CMExit(var Msg : TMessage);
  374.       message CM_EXIT;
  375.     procedure CMFontChanged(var Msg : TMessage);
  376.       message CM_FONTCHANGED;
  377.  
  378.     {windows message handlers}
  379.     procedure WMCancelMode(var Msg : TMessage);
  380.       message WM_CANCELMODE;
  381.     procedure WMEraseBkgnd(var Msg : TWMEraseBkgnd);
  382.       message WM_ERASEBKGND;
  383.     procedure WMGetText(var Msg : TWMGetText);
  384.       message WM_GETTEXT;
  385.     procedure WMGetTextLength(var Msg : TWMGetTextLength);
  386.       message WM_GETTEXTLENGTH;
  387.     procedure WMKeyDown(var Msg : TWMKeyDown);
  388.       message WM_KEYDOWN;
  389.     procedure WMKillFocus(var Msg : TWMKillFocus);
  390.       message WM_KILLFOCUS;
  391.     procedure WMLButtonDown(var Msg : TWMMouse);
  392.       message WM_LBUTTONDOWN;
  393.     procedure WMLButtonUp(var Msg : TWMMouse);
  394.       message WM_LBUTTONUP;
  395.     procedure WMMouseMove(var Msg : TWMMouse);
  396.       message WM_MOUSEMOVE;
  397.     procedure WMNCHitTest(var Msg : TWMNCHitTest);
  398.       message WM_NCHITTEST;
  399.     procedure WMSetText(var Msg : TWMSetText);
  400.       message WM_SETTEXT;
  401.     procedure WMSetCursor(var Msg : TWMSetCursor);
  402.       message WM_SETCURSOR;
  403.  
  404.   protected
  405.     procedure CreateParams(var Params : TCreateParams);
  406.       override;
  407.     procedure CreateWnd;
  408.       override;
  409.     procedure KeyDown(var Key : Word; Shift : TShiftState);
  410.       override;
  411.     procedure MouseDown(Button : TMouseButton; Shift : TShiftState; X, Y : Integer);
  412.       override;
  413.     procedure MouseUp(Button : TMouseButton; Shift : TShiftState; X, Y : Integer);
  414.       override;
  415.     procedure Paint;
  416.       override;
  417.   {.Z-}
  418.  
  419.     {protected properties}
  420.     property BorderStyle : TBorderStyle
  421.       read FBorderStyle write SetBorderStyle;
  422.     property Colors : TOvcCalcColors
  423.       read FColors write FColors;
  424.     property Decimals : Integer
  425.       read GetDecimals write SetDecimals;
  426.     property MaxPaperCount : Integer
  427.       read GetMaxPaperCount write SetMaxPaperCount;
  428.     property Options : TOvcCalculatorOptions
  429.       read  FOptions write SetOptions;
  430.     property TapeFont : TFont
  431.       read GetTapeFont write SetTapeFont;
  432.     property TapeHeight : Integer
  433.       read GetTapeHeight write SetTapeHeight;
  434.     property TapeSeparatorChar : Char
  435.       read FTapeSeparatorChar write FTapeSeparatorChar;
  436.     property Visible : Boolean
  437.       read GetVisible write SetVisible;
  438.  
  439.     {protected events}
  440.     property OnButtonPressed : TOvcCalcButtonPressedEvent
  441.       read FOnButtonPressed  write FOnButtonPressed;
  442.  
  443.   public
  444.   {.Z+}
  445.     constructor Create(AOwner : TComponent);
  446.       override;
  447.     constructor CreateEx(AOwner : TComponent; AsPopup : Boolean);
  448.       virtual;
  449.     destructor Destroy;
  450.       override;
  451.     procedure KeyPress(var Key : Char);
  452.       override;
  453.     procedure PushOperand(const Value : Extended);
  454.     procedure SetBounds(ALeft, ATop, AWidth, AHeight : Integer);
  455.       override;
  456.   {.Z-}
  457.  
  458.     procedure CopyToClipboard;
  459.     procedure PasteFromClipboard;
  460.     procedure PressButton(Button : TOvcCalculatorButton);
  461.  
  462.     {public properties}
  463.     property LastOperand : Extended
  464.       read FLastOperand write FLastOperand;
  465.     property Memory : Extended
  466.       read GetMemory write SetMemory;
  467.     property Operand : Extended
  468.       read GetOperand write SetOperand;
  469.     property DisplayStr : string
  470.       read FDisplayStr write SetDisplayStr;
  471.     property DisplayValue : Extended
  472.       read FDisplay write SetDisplay;
  473.     property Tape : TStrings
  474.       read GetTape write SetTape;
  475.   end;
  476.  
  477.   TOvcCalculator = class(TOvcCustomCalculator)
  478.   published
  479.     {properties}
  480.     {$IFDEF VERSION4}
  481.     property Anchors;
  482.     property Constraints;
  483.     property DragKind;
  484.     {$ENDIF}
  485.     property About;
  486.     property Align;
  487.     property BorderStyle;
  488.     property Ctl3D;
  489.     property Font;  {must be prior to "Colors"}
  490.     property TapeFont; {must be prior to "Colors"}
  491.     property Colors;
  492.     property Cursor;
  493.     property Decimals;
  494.     property DragCursor;
  495.     property DragMode;
  496.     property Enabled;
  497.     property LabelInfo;
  498.     property MaxPaperCount;
  499.     property TapeHeight; {Must be Prior to Options}
  500.     property Options;
  501.     property ParentCtl3D;
  502.     property ParentFont;
  503.     property ParentShowHint;
  504.     property PopupMenu;
  505.     property ShowHint;
  506.     property TabOrder;
  507.     property TabStop;
  508.     property TapeSeparatorChar;
  509.     property Visible;
  510.  
  511.     {events}
  512.     property OnButtonPressed;
  513.     property OnDragDrop;
  514.     property OnDragOver;
  515.     property OnEndDrag;
  516.     property OnEnter;
  517.     property OnExit;
  518.     property OnKeyDown;
  519.     property OnKeyPress;
  520.     property OnKeyUp;
  521.     property OnMouseDown;
  522.     property OnMouseMove;
  523.     property OnMouseUp;
  524.     {$IFDEF Win32}
  525.     property OnMouseWheel;
  526.     property OnStartDrag;
  527.     {$ENDIF Win32}
  528.   end;
  529.  
  530.  
  531. implementation
  532.  
  533. const
  534.   calcDefMinSize = 30;
  535.  
  536.  
  537. {*** TOvcCalcColors ***}
  538.  
  539. procedure TOvcCalcColors.Assign(Source : TPersistent);
  540. begin
  541.   if Source is TOvcCalcColors then begin
  542.     FCalcColors := TOvcCalcColors(Source).FCalcColors;
  543.     FColorScheme := TOvcCalcColors(Source).FColorScheme;
  544.     FOnChange := TOvcCalcColors(Source).FOnChange;
  545.   end else
  546.     inherited Assign(Source);
  547. end;
  548.  
  549. procedure TOvcCalcColors.BeginUpdate;
  550. begin
  551.   FUpdating := True;
  552. end;
  553.  
  554. procedure TOvcCalcColors.EndUpdate;
  555. begin
  556.   FUpdating := False;
  557.   DoOnChange;
  558. end;
  559.  
  560. procedure TOvcCalcColors.DoOnChange;
  561. begin
  562.   if not FUpdating and Assigned(FOnChange) then
  563.     FOnChange(Self);
  564.  
  565.   if not SettingScheme then
  566.     FColorScheme := cscalcCustom;
  567. end;
  568.  
  569. function TOvcCalcColors.GetColor(const Index : Integer) : TColor;
  570. begin
  571.   Result := FCalcColors[Index];
  572. end;
  573.  
  574. procedure TOvcCalcColors.SetColor(const Index : Integer; const Value : TColor);
  575. begin
  576.   if Value <> FCalcColors[Index] then begin
  577.     FCalcColors[Index] := Value;
  578.     DoOnChange;
  579.   end;
  580. end;
  581.  
  582. procedure TOvcCalcColors.SetColorScheme(const Value : TOvcCalcColorScheme);
  583. begin
  584.   if Value <> FColorScheme then begin
  585.     SettingScheme := True;
  586.     try
  587.       FColorScheme := Value;
  588.       if Value <> cscalcCustom then begin
  589.         FCalcColors := CalcScheme[Value];
  590.         DoOnChange;
  591.       end;
  592.     finally
  593.       SettingScheme := False;
  594.     end;
  595.   end;
  596. end;
  597.  
  598. procedure TOvcCalcColors.SetDisplayTextColor(const Value : TColor);
  599. begin
  600.   if Value <> FCalcColors[2] then begin
  601.     FCalcColors[2] := Value;
  602.     DoOnChange;
  603.   end;
  604. end;
  605.  
  606.  
  607. {*** TOvcCalcTape ***}
  608.  
  609. constructor TOvcCalcTape.Create(const AOwner : TComponent; const AOperandSize : Integer);
  610. begin
  611.   inherited Create;
  612.   taOwner           := AOwner;
  613.   FVisible          := False;
  614.   taOperandSize     := AOperandSize;
  615.   taFont            := TFont.Create;
  616.   taFont.Name       := 'Courier New';
  617.   taFont.Size       := 10;
  618.   taFont.Style      := [];
  619. end;
  620.  
  621. destructor TOvcCalcTape.Destroy;
  622. begin
  623.   taFont.Free;
  624.   taFont := nil;
  625.  
  626.   inherited Destroy;
  627. end;
  628.  
  629. procedure TOvcCalcTape.ValidateListBox;
  630. begin
  631.   if not Assigned(taListBox) then begin
  632.     taListBox := TListBox.Create(taOwner);
  633.     with taListBox do begin
  634.       OnClick         := taOnClick;
  635.       OnDblClick      := taOnDblClick;
  636.       OnDrawItem      := taOnDrawItem;
  637.       Style           := lbOwnerDrawFixed;
  638.       Parent          := taOwner as TWinControl;
  639.       ParentFont      := False;
  640.       ParentCtl3D     := True;
  641.       BorderStyle     := bsSingle;
  642.       Color           := taTapeColor;
  643.       Visible         := FVisible;
  644.       Width           := taWidth;
  645.       Height          := taHeight;
  646.       Font.Assign(taFont);
  647.       Font.OnChange   := taFont.OnChange;
  648.       taFont.OnChange := taTapeFontChange;
  649.     end;
  650.     taTapeInitialized := False;
  651.   end;
  652.   InitializeTape;
  653. end;
  654.  
  655. procedure TOvcCalcTape.Add(const Value : string);
  656. begin
  657.   ValidateListBox;
  658.   taListBox.Items.Add(Value);
  659. end;
  660.  
  661. procedure TOvcCalcTape.DeleteFirst;
  662. begin
  663.   ValidateListBox;
  664.   with taListBox, Items do
  665.     if Strings[0] = '' then
  666.       taListBox.Items.Delete(0)
  667.     else
  668.       Inc(taMaxTapeCount);
  669. end;
  670.  
  671. procedure TOvcCalcTape.SetFont(const Value : TFont);
  672. begin
  673.   taFont.Assign(Value);
  674.   taFont.OnChange(Self);
  675. end;
  676.  
  677. function TOvcCalcTape.GetFont : TFont;
  678. begin
  679.   Result := taFont;
  680. end;
  681.  
  682. procedure TOvcCalcTape.SetHeight(const Value : Integer);
  683. begin
  684.   taHeight := Value;
  685.   if Visible then begin
  686.     ValidateListBox;
  687.     taListBox.Height := Value;
  688.   end;
  689. end;
  690.  
  691. function TOvcCalcTape.GetHeight : Integer;
  692. begin
  693.   if Visible then begin
  694.     ValidateListBox;
  695.     Result := taListBox.Height;
  696.   end else
  697.     Result := taHeight;
  698. end;
  699.  
  700. function TOvcCalcTape.GetTape : TStrings;
  701. begin
  702.   ValidateListBox;
  703.   Result := taListBox.Items;
  704. end;
  705.  
  706. procedure TOvcCalcTape.SetTape(const Value : TStrings);
  707. begin
  708.   ValidateListBox;
  709.   taListBox.Items.Assign(Value);
  710. end;
  711.  
  712. function TOvcCalcTape.GetTapeColor : TColor;
  713. begin
  714.   if Visible then begin
  715.     ValidateListBox;
  716.     Result := taListBox.Color;
  717.   end else
  718.     Result := taTapeColor;
  719. end;
  720.  
  721. procedure TOvcCalcTape.SetTapeColor(const Value : TColor);
  722. begin
  723.   taTapeColor := Value;
  724.   if Visible then begin
  725.     ValidateListBox;
  726.     taListBox.Color := Value;
  727.   end;
  728. end;
  729.  
  730. procedure TOvcCalcTape.SetTop(const Value : Integer);
  731. begin
  732.   ValidateListBox;
  733.   taListBox.Top := Value;
  734. end;
  735.  
  736. function TOvcCalcTape.GetTop : Integer;
  737. begin
  738.   ValidateListBox;
  739.   Result := taListBox.Top;
  740. end;
  741.  
  742. function TOvcCalcTape.GetVisible : Boolean;
  743. begin
  744.   Result := FVisible;
  745. end;
  746.  
  747. procedure TOvcCalcTape.SetVisible(const Value : Boolean);
  748. begin
  749.   FVisible := Value;
  750.   if Assigned(taListBox) then begin
  751.     if not Value and taListBox.Visible then begin
  752.       if csDesigning in taListBox.Owner.ComponentState then begin
  753.         {$IFDEF VERSION4}
  754.         taListBox.Visible := Value;
  755.         taListBox.Height := 0;
  756.         {$ELSE}
  757.         taListBox.Free;
  758.         taListBox := nil;
  759.         {$ENDIF}
  760.       end else
  761.         taListBox.Visible := Value;
  762.     end else if Value and not taListBox.Visible then begin
  763.       taListBox.Visible := Value;
  764.       {$IFDEF VERSION4}
  765.       taListBox.Height := taHeight;
  766.       {$ENDIF}
  767.     end;
  768.   end else if Value then begin
  769.     ValidateListBox;
  770.     taListBox.Visible := Value;
  771.   end;
  772. end;
  773.  
  774. procedure TOvcCalcTape.SetWidth(const Value : Integer);
  775. begin
  776.   taWidth := Value;
  777.   if Visible then begin
  778.     ValidateListBox;
  779.     taListBox.Width := Value;
  780.   end;
  781. end;
  782.  
  783. function TOvcCalcTape.GetWidth : Integer;
  784. begin
  785.   if Visible then begin
  786.     ValidateListBox;
  787.     Result := taListBox.Width;
  788.   end else
  789.     Result := taWidth;
  790. end;
  791.  
  792. procedure TOvcCalcTape.SetTopIndex(const Value : Integer);
  793. begin
  794.   ValidateListBox;
  795.   taListBox.TopIndex := Value;
  796. end;
  797.  
  798. function TOvcCalcTape.GetTopIndex : Integer;
  799. begin
  800.   ValidateListBox;
  801.   Result := taListBox.TopIndex;
  802. end;
  803.  
  804. procedure TOvcCalcTape.SetBounds(const ALeft, ATop, AWidth, AHeight : Integer);
  805. begin
  806.   ValidateListBox;
  807.   taListBox.SetBounds(ALeft, ATop, AWidth, AHeight);
  808. end;
  809.  
  810. procedure TOvcCalcTape.InitializeTape;
  811. begin
  812.   if not Assigned(taListBox) then
  813.     Exit;
  814.   if csDesigning in taListBox.Owner.ComponentState then
  815.     if not taListBox.HandleAllocated then
  816.       Exit;
  817.   if taTapeInitialized then
  818.     Exit;
  819.   ClearTape;
  820.   taTapeInitialized := True;
  821. end;
  822.  
  823. procedure TOvcCalcTape.taOnClick(Sender : TObject);
  824. begin
  825.   ValidateListBox;
  826.   (taListBox.Owner as TOvcCustomCalculator).SetFocus;
  827. end;
  828.  
  829. procedure TOvcCalcTape.taOnDblClick(Sender : TObject);
  830. var
  831.   Str : string;
  832. begin
  833.   ValidateListBox;
  834.   Str := taListBox.Items.Strings[taListBox.ItemIndex];
  835.   try
  836.     if (Str[1] = '0') and
  837.        (Str[2] <> '.') then
  838.       Exit;
  839.     if taListBox.Items.Strings[taListBox.ItemIndex] <> '' then begin
  840.       (taListBox.Owner as TOvcCustomCalculator).DisplayValue :=
  841.         StrToFloat(Copy(Str,1,  Length(Str) - taOperandSize));
  842.       (taListBox.Owner as TOvcCustomCalculator).LastOperand :=
  843.         StrToFloat(Copy(Str,1,  Length(Str) - taOperandSize));
  844.       (taListBox.Owner as TOvcCustomCalculator).Operand :=
  845.         StrToFloat(Copy(Str,1,  Length(Str) - taOperandSize));
  846.       (taListBox.Owner as TOvcCustomCalculator).DisplayStr :=
  847.         Copy(Str,1,             Length(Str) - taOperandSize);
  848.       (taListBox.Owner as TOvcCustomCalculator).SetFocus;
  849.     end;
  850.   except
  851.   end;
  852. end;
  853.  
  854. procedure TOvcCalcTape.taOnDrawItem(Control: TWinControl; Index: Integer;
  855.                                    Rect:TRect;State: TOwnerDrawState);
  856. var
  857.   SaveColor : TColor;
  858.   SaveBack : TColor;
  859.   Str : String;
  860.   I, FirstUsedIndex : Integer;
  861. begin
  862.   FirstUsedIndex := 0;
  863.   if Index > FMaxPaperCount then
  864.     with (Control as TListBox) do begin
  865.       for I := 0 to Index do begin
  866.         if Items[I] <> '' then begin
  867.           FirstUsedIndex := I;
  868.           Break;
  869.         end;
  870.       end;
  871.     end;
  872.  
  873.   Str := (Control as TListBox).Items[Index];
  874.   with (Control as TListBox).Canvas do begin        { draw on control canvas, not on the form }
  875.     FillRect(Rect);                          { clear the rectangle }
  876.  
  877.     SaveColor := (Control as TListBox).Canvas.Font.Color;
  878.     try
  879.       SaveBack := (Control as TListBox).Canvas.Brush.Color;
  880.       try
  881.         if (Trim(Str) <> '') then begin
  882.           if (Trim(Str)[1] = '-') then
  883.             (Control as TListBox).Canvas.Font.Color := clRed;
  884.           if FTapeDisplaySpace > Length(Str) then
  885.             Str := Str + StringOfChar(' ', FTapeDisplaySpace - Length(Str));
  886.           TextOut(Rect.Left, Rect.Top, Copy(Str, 1, Length(Str) - 1));
  887.           if Index - FirstUsedIndex >= FMaxPaperCount then
  888.             (Control as TListBox).Canvas.Brush.Color := clRed;
  889.           TextOut(PenPos.X, PenPos.Y, Copy(Str, Length(Str), 1));
  890.         end;
  891.       finally
  892.         (Control as TListBox).Canvas.Brush.Color := SaveBack;
  893.       end;
  894.     finally
  895.       (Control as TListBox).Canvas.Font.Color := SaveColor;
  896.     end;
  897.   end;
  898. end;
  899.  
  900. procedure TOvcCalcTape.taTapeFontChange(Sender : TObject);
  901. begin
  902.   if Visible then begin
  903.     taListBox.Font.Assign(taFont);
  904.     taListBox.Font.OnChange(Sender);
  905.   end;
  906. end;
  907.  
  908. function TOvcCalcTape.GetDisplayedItemCount : Integer;
  909. var
  910.   DC         : hDC;
  911.   SaveFont   : hFont;
  912.   Size       : TSize;
  913. begin
  914.   if not Assigned(taListBox) then begin
  915.     Result := 0;
  916.     Exit;
  917.   end;
  918.  
  919.   DC := GetDC(0);
  920.   SaveFont := SelectObject(DC, taListBox.Font.Handle);
  921.   GetTextExtentPoint(DC, ' 0123456789', 11, Size);
  922.   Result := taListBox.ClientHeight div Size.cy;
  923.   if Result < 3 then
  924.     Result := 3;
  925.   SelectObject(DC, SaveFont);
  926.   ReleaseDC(0, DC);
  927. end;
  928.  
  929. procedure TOvcCalcTape.AddToTape(const Value : string; OpString : string);
  930.   {-adds an operand to the tape display}
  931. var
  932.   TapeString : string;
  933.   DSpace     : Integer;
  934. begin
  935.   DSpace := FTapeDisplaySpace - Length(Value);
  936.   TapeString := StringOfChar(' ', DSpace - taOperandSize);
  937.   TapeString := TapeString + Value + ' ' + OpString;
  938.   Add(TapeString);
  939.   DeleteFirst;
  940.   TopIndex := taMaxTapeCount - GetDisplayedItemCount + 2;
  941. end;
  942.  
  943. {adds an operand to the tape display}
  944. procedure TOvcCalcTape.AddToTapeLeft(const Value : string);
  945. var
  946.   TapeString : string;
  947.   DSpace : Integer;
  948. begin
  949.   DSpace := FTapeDisplaySpace - Length(Value);
  950.   TapeString := StringOfChar(' ', DSpace);
  951.   TapeString := Value + TapeString;
  952.   Add(Value);
  953.   DeleteFirst;
  954.   TopIndex := taMaxTapeCount - GetDisplayedItemCount + 2;
  955. end;
  956.  
  957. procedure TOvcCalcTape.ClearTape;
  958. var
  959.   I : Integer;
  960. begin
  961.   if not Assigned(taListBox) then
  962.     Exit;
  963.   if csDesigning in taListBox.Owner.ComponentState then
  964.     if not taListBox.HandleAllocated then
  965.       Exit;
  966.   taMaxTapeCount := 30; {set starting line count}
  967.  
  968.   taListBox.Items.Clear;
  969.   for I := 0 to taMaxTapeCount - 1 do
  970.     taListBox.Items.Add('');
  971.   taListBox.TopIndex := taMaxTapeCount - GetDisplayedItemCount + 2;
  972. end;
  973.  
  974. procedure TOvcCalcTape.RefreshDisplays;
  975. var
  976.   I, Diff : Integer;
  977.   S : string;
  978.  
  979.   function AllSame(Str : string) : Boolean;
  980.   var
  981.     I : Integer;
  982.   begin
  983.     Result := True;
  984.     for I := 2 to Length(Str) do begin
  985.       if Str[1] <> Str[I] then
  986.         Exit;
  987.     end;
  988.   end;
  989.  
  990. begin
  991.   if not Assigned(taListBox) then
  992.     Exit;
  993.   if not taListBox.HandleAllocated then
  994.     Exit;
  995.  
  996.   if FShowTape then begin
  997.     for I := 0 to taMaxTapeCount - 1 do begin
  998.       S := taListBox.Items.Strings[I];
  999.       if S <> '' then begin
  1000.         Diff := FTapeDisplaySpace - Length(S);
  1001.         if S[1] = ' ' then begin
  1002.           if Diff >= 0 then
  1003.             S := StringOfChar(' ', Diff) + S
  1004.           else if AllSame(copy(S, 1, -Diff)) then
  1005.             S := copy(S,-Diff + 1, Length(S));
  1006.         end else begin
  1007.           if AllSame(S) and (not (S[1] in ['0'..'9'])) then
  1008.             if Diff >= 0 then
  1009.               S := S + StringOfChar(S[1], Diff)
  1010.             else
  1011.               S := copy(S, 1, Length(S)-Diff + 1)
  1012.           else if (Diff >= 0) and not ((S[1] <> '0') or (S[2] <> '.')) then
  1013.             S :=  StringOfChar(' ', Diff) + S;
  1014.         end;
  1015.         taListBox.Items.Strings[I] := S;
  1016.       end;
  1017.     end;
  1018.     taListBox.TopIndex := taMaxTapeCount - GetDisplayedItemCount + 2;
  1019.   end;
  1020. end;
  1021.  
  1022. procedure TOvcCalcTape.SpaceTape(const Value : char);
  1023. var
  1024.   TapeString : string;
  1025. begin
  1026.   TapeString := StringOfChar(Value, FTapeDisplaySpace);
  1027.   Add(TapeString);
  1028.   DeleteFirst;
  1029.   TopIndex := taMaxTapeCount - GetDisplayedItemCount + 2;
  1030. end;
  1031.  
  1032.  
  1033. {*** TOvcCustomCalculatorEngine ***}
  1034.  
  1035. procedure TOvcCustomCalculatorEngine.ClearAll;
  1036. var
  1037.   I : Integer;
  1038. begin
  1039.   for I := 0 to 3 do
  1040.     cOperands[I] := 0;
  1041.   cLastOperation := coNone;
  1042.   cOperationCount := 0;
  1043.   cState := [csValid, csClear];
  1044. end;
  1045.  
  1046. procedure TOvcCustomCalculatorEngine.PushOperand(const Value : Extended);
  1047. var
  1048.   I : Integer;
  1049. begin
  1050.   for I := 2 downto 0 do
  1051.     cOperands[I+1] := cOperands[I];
  1052.   cOperands[0] := Value;
  1053. end;
  1054.  
  1055. function TOvcCustomCalculatorEngine.PopOperand : Extended;
  1056. var
  1057.   I : Integer;
  1058. begin
  1059.   Result := cOperands[0];
  1060.   for I := 0 to 2 do
  1061.     cOperands[I] := cOperands[I+1];
  1062.   cOperands[3] := 0;
  1063. end;
  1064.  
  1065. function TOvcCustomCalculatorEngine.TopOperand : Extended;
  1066. begin
  1067.   Result := cOperands[0];
  1068. end;
  1069.  
  1070.  
  1071. {*** TOvcBasicCalculatorEngine ***}
  1072. type
  1073.   TOvcBasicCalculatorEngine = class(TOvcCustomCalculatorEngine)
  1074.   protected {private}
  1075.     {internal methods}
  1076.     procedure cEvaluate(const Operation : TOvcCalculatorOperation);
  1077.   public
  1078.     function AddOperand(const Value : Extended; const Button : TOvcCalculatorOperation) : Boolean;
  1079.         override;
  1080.     function AddOperation(const Button : TOvcCalculatorOperation) : Boolean;
  1081.         override;
  1082.   end;
  1083.  
  1084. function TOvcBasicCalculatorEngine.AddOperand(
  1085.   const Value : Extended;
  1086.   const Button : TOvcCalculatorOperation) : Boolean;
  1087. var
  1088.   I : Integer;
  1089. begin
  1090.   Result := False;
  1091.   if Button <> coNone then begin
  1092.     if csValid in cState then begin
  1093.       Result := True;
  1094.       for I := 2 downto 0 do
  1095.         cOperands[I+1] := cOperands[I];
  1096.       cOperands[0] := Value;
  1097.     end;
  1098.   end;
  1099. end;
  1100.  
  1101. procedure TOvcBasicCalculatorEngine.cEvaluate(const Operation : TOvcCalculatorOperation);
  1102. begin
  1103.   if csValid in cState then begin
  1104.     {evaluate the expression}
  1105.     case Operation of
  1106.       coAdd        : begin
  1107.                        cOperands[1] := cOperands[1] + cOperands[0];
  1108.                        PopOperand;
  1109.                      end;
  1110.       coSub        : begin
  1111.                        cOperands[1] := cOperands[1] - cOperands[0];
  1112.                        PopOperand;
  1113.                      end;
  1114.       coMul        : begin
  1115.                        cOperands[1] := cOperands[1] * cOperands[0];
  1116.                        PopOperand;
  1117.                      end;
  1118.       coDiv        : begin
  1119.                        cOperands[1] := cOperands[1] / cOperands[0];
  1120.                        PopOperand;
  1121.                      end;
  1122.       coEqual      : ;
  1123.       coNone       : ;
  1124.       coPercent    : begin
  1125.                        if cLastOperation in [coAdd, coSub] then
  1126.                          cOperands[0] := (cOperands[0] / 100) * cOperands[1]  {do markup/down}
  1127.                        else
  1128.                          cOperands[0] := cOperands[0] / 100; {as a percentage}
  1129.                        cState := [csValid, csClear];
  1130.                      end;
  1131.       coMemStore   : begin
  1132.                        cMemory := cOperands[0];
  1133.                        Include(cState, csClear);
  1134.                      end;
  1135.       coMemRecall  : begin
  1136.                        cOperands[0] := cMemory;
  1137.                        cState := [csValid, csClear];
  1138.                      end;
  1139.       coMemClear   : begin
  1140.                        cMemory := 0;
  1141.                      end;
  1142.       coMemAdd,
  1143.       coMemSub     : begin
  1144.                        try
  1145.                          if Operation = coMemAdd then
  1146.                            cMemory := cMemory + cOperands[0]
  1147.                          else
  1148.                            cMemory := cMemory - cOperands[0];
  1149.                        except
  1150.                          cMemory := 0;
  1151.                        end;
  1152.                        Include(cState, csClear);
  1153.                      end;
  1154.       coInvert     : begin
  1155.                        cOperands[0] := 1 / cOperands[0];
  1156.                      end;
  1157.       coSqrt       : begin
  1158.                        cOperands[0] := Sqrt(cOperands[0]);
  1159.                      end;
  1160.     end;
  1161.   end;
  1162. end;
  1163.  
  1164. function TOvcBasicCalculatorEngine.AddOperation(const Button : TOvcCalculatorOperation) : Boolean;
  1165. begin
  1166.   Result := False;
  1167.   if csValid in cState then begin
  1168.     {evaluate the expression}
  1169.     case Button of
  1170.       coAdd        : begin
  1171.                        cEvaluate(cLastOperation);
  1172.                        cState := [csValid, csClear];
  1173.                        if cLastOperation in [coAdd, coSub] then
  1174.                          Inc(cOperationCount)
  1175.                        else
  1176.                          cOperationCount := 1;
  1177.                        cLastOperation := Button;
  1178.                        Result := True;
  1179.                      end;
  1180.       coSub        : begin
  1181.                        cEvaluate(cLastOperation);
  1182.                        cState := [csValid, csClear];
  1183.                        if cLastOperation in [coAdd, coSub] then
  1184.                          Inc(cOperationCount)
  1185.                        else
  1186.                          cOperationCount := 1;
  1187.                        cLastOperation := Button;
  1188.                        Result := True;
  1189.                      end;
  1190.       coMul        : begin
  1191.                        cEvaluate(cLastOperation);
  1192.                        cState := [csValid, csClear];
  1193.                        if cLastOperation = Button then
  1194.                          cOperationCount := cOperationCount + 1
  1195.                        else
  1196.                          cOperationCount := 1;
  1197.                        cLastOperation := Button;
  1198.                        Result := True;
  1199.                      end;
  1200.       coDiv        : begin
  1201.                        cEvaluate(cLastOperation);
  1202.                        cState := [csValid, csClear];
  1203.                        if cLastOperation = Button then
  1204.                          cOperationCount := cOperationCount + 1
  1205.                        else
  1206.                          cOperationCount := 1;
  1207.                        cLastOperation := Button;
  1208.                        Result := True;
  1209.                      end;
  1210.       coEqual      : begin
  1211.                        Include(cState, csClear);
  1212.                        if cLastOperation <> coNone then begin
  1213.                          cEvaluate(cLastOperation);
  1214.                          cState := [csClear, csValid];
  1215.                          if cLastOperation = coEqual then
  1216.                            cLastOperation := coNone
  1217.                          else
  1218.                            cLastOperation := Button;
  1219.                          Result := True;
  1220.                        end;
  1221.                      end;
  1222.       coNone       : Result := True;
  1223.       coPercent    : begin
  1224.                        cEvaluate(Button);
  1225.                        if not ShowSeparatePercent then begin
  1226.                          cEvaluate(cLastOperation);
  1227.                          cState := [csValid, csClear];
  1228.                          if cLastOperation = Button then
  1229.                            cOperationCount := cOperationCount + 1
  1230.                          else
  1231.                            cOperationCount := 0;
  1232.                          cLastOperation := coEqual;
  1233.                          Result := True;
  1234.                        end else begin
  1235.                          if cLastOperation = Button then
  1236.                            cOperationCount := cOperationCount + 1
  1237.                          else
  1238.                            cOperationCount := 0;
  1239.                          Result := True;
  1240.                        end;
  1241.                      end;
  1242.       coMemStore   : begin
  1243.                        cEvaluate(Button);
  1244.                      end;
  1245.       coMemRecall  : begin
  1246.                        cEvaluate(Button);
  1247.                        Result := True;
  1248.                      end;
  1249.       coMemClear   : begin
  1250.                        cEvaluate(Button);
  1251.                      end;
  1252.       coMemAdd,
  1253.       coMemSub     : begin
  1254.                        cEvaluate(Button);
  1255.                      end;
  1256.       coInvert     : begin
  1257.                        cEvaluate(Button);
  1258.                        Result := True;
  1259.                      end;
  1260.       coSqrt       : begin
  1261.                        cEvaluate(Button);
  1262.                        Result := True;
  1263.                      end;
  1264.     end;
  1265.   end;
  1266. end;
  1267.  
  1268.  
  1269. {*** TOvcCalcPanel ***}
  1270.  
  1271. procedure TOvcCalcPanel.Click;
  1272. begin
  1273.   (Owner as TOvcCustomCalculator).SetFocus;
  1274. end;
  1275.  
  1276.  
  1277. {*** TOvcCustomCalculator ***}
  1278.  
  1279. procedure TOvcCustomCalculator.cAdjustHeight;
  1280. var
  1281.   DC         : hDC;
  1282.   SaveFont   : hFont;
  1283.   I          : Integer;
  1284.   SysMetrics : TTextMetric;
  1285.   Metrics    : TTextMetric;
  1286. begin
  1287.   DC := GetDC(0);
  1288.   GetTextMetrics(DC, SysMetrics);
  1289.   SaveFont := SelectObject(DC, Font.Handle);
  1290.   GetTextMetrics(DC, Metrics);
  1291.   SelectObject(DC, SaveFont);
  1292.   ReleaseDC(0, DC);
  1293.   if NewStyleControls then begin
  1294.     if Ctl3D then
  1295.       I := 8
  1296.     else
  1297.       I := 6;
  1298.     I := GetSystemMetrics(SM_CYBORDER) * I;
  1299.   end else begin
  1300.     I := SysMetrics.tmHeight;
  1301.     if I > Metrics.tmHeight then
  1302.       I := Metrics.tmHeight;
  1303.     I := I div 4 + GetSystemMetrics(SM_CYBORDER) * 4;
  1304.   end;
  1305.   cPanel.Height := Metrics.tmHeight + I;
  1306. end;
  1307.  
  1308. procedure TOvcCustomCalculator.cCalculateLook;
  1309. var
  1310.   CW  : Integer;  {client width}
  1311.   BW  : Integer;  {button width}
  1312.   BH  : Integer;  {button height}
  1313.   LBW : Integer;  {large button width}
  1314.   M1  : Integer;  {margin between buttons}
  1315.   M2  : Integer;  {left and right edge margins}
  1316.   M3  : Integer;  {margin between panel and frst row of buttons}
  1317.   M4  : Integer;  {margin between memory buttons and other buttons}
  1318.   TM  : Integer;  {area where the panel is placed}
  1319.   X   : Integer;
  1320.   Y   : Integer;
  1321.   PW  : Integer;  {panel width}
  1322.   B   : TOvcCalculatorButton;
  1323. begin
  1324.   if not HandleAllocated then
  1325.     Exit;
  1326.  
  1327.   {set panel height based on font}
  1328.   cAdjustHeight;
  1329.  
  1330.   for B := Low(cButtons) to High(cButtons) do
  1331.     cButtons[B].Visible := True;
  1332.  
  1333.   CW := ClientWidth;
  1334.  
  1335.   if Width <= 200 then begin
  1336.     M1 := 2;
  1337.     M2 := 4;
  1338.   end else begin
  1339.     M1 := 4;
  1340.     M2 := 6;
  1341.   end;
  1342.   {save left/right/top/bottom margin value}
  1343.   cMargin := M2;
  1344.  
  1345.   M4 := M2;
  1346.   if coShowMemoryButtons in FOptions then begin
  1347.     BW := (CW - 3*M2 - 4*M1) div 6;
  1348.     M4 := CW - 2*M2 - 6*BW - 4*M1;
  1349.   end else begin
  1350.     BW := (CW - 2*M2 - 4*M1) div 5;
  1351.     if (CW - 2*M2 - 4*M1) div 6 >= 4 then
  1352.       Inc(M2, 2)
  1353.     else if (CW - 2*M2 - 4*M1) div 6 >= 2 then
  1354.       Inc(M2, 1);
  1355.   end;
  1356.  
  1357.   {button height, using an estimate for TM}
  1358.   TM := M2 + M2 + cPanel.Height;
  1359.  
  1360.   if coShowTape in FOptions then
  1361.     TM := TM + M2 + cTape.Height;
  1362.  
  1363.   BH := (ClientHeight - TM - M2 - 4*M1) div 5;
  1364.  
  1365.   {calculate actual area below panel}
  1366.   M3 := ClientHeight - M2 - cPanel.Height - 5*BH - 4*M1 - M2;
  1367.  
  1368.   {calculate actual height of area above buttons}
  1369.   TM := M2 + M3 + cPanel.Height;
  1370.  
  1371.   {large button width}
  1372.   if coShowClearTapeButton in FOptions then
  1373.     LBW := (5*BW + 3*M1 - 2*M1) div 4
  1374.   else
  1375.     LBW := (4*BW + 3*M1 - 2*M1) div 3;
  1376.  
  1377.   {calculate the width of the edit window}
  1378.   cMargin := M2;
  1379.   if coShowMemoryButtons in FOptions then
  1380.     PW := 6*BW + M4 + 4*M1
  1381.   else
  1382.     PW := 5*BW + 4*M1;
  1383.  
  1384.   if coShowTape in FOptions then
  1385.     PW := PW - cScrBarWidth;
  1386.  
  1387.  
  1388.   {position tape display and edit panel}
  1389.   if coShowTape in FOptions then begin
  1390.     cTape.Visible := True;
  1391.     cTape.SetBounds(cMargin, cMargin, PW + cScrBarWidth, cTape.Height);
  1392.     cPanel.SetBounds(cMargin + 2, cTape.Height + M2 +
  1393.                      cMargin, PW, cPanel.Height);
  1394.   end else begin
  1395.     cTape.Visible := False;
  1396.     cPanel.SetBounds(cMargin, cMargin, PW, cPanel.Height);
  1397.   end;
  1398.  
  1399.   {calculate # of characters required to fill display space}
  1400.   {"FontWidth div 2" makes sure there is no cut off charaters}
  1401.   if coShowTape in FOptions then
  1402.     cTape.TapeDisplaySpace := (cTape.Width - cScrBarWidth - (cGetFontWidth div 2))
  1403.                       div cGetFontWidth
  1404.   else
  1405.     cTape.TapeDisplaySpace := (cPanel.Width - (cGetFontWidth div 2)) div cGetFontWidth;
  1406.  
  1407.   cTape.InitializeTape;
  1408.  
  1409.   {redraw the edit panel and Tape}
  1410.   cRefreshDisplays;
  1411.  
  1412.   {memory column}
  1413.   if coShowMemoryButtons in FOptions then begin
  1414.     X := M2;
  1415.     Y := TM;
  1416.     cButtons[cbMemClear].Position := Rect(X, Y, X+BW, Y+BH);
  1417.     cButtons[cbMemClear].Caption := GetOrphStr(SCCalcMC);
  1418.  
  1419.     Y := TM + BH + M1;
  1420.     cButtons[cbMemRecall].Position := Rect(X, Y, X+BW, Y+BH);
  1421.     cButtons[cbMemRecall].Caption := GetOrphStr(SCCalcMR);
  1422.  
  1423.     Y := TM + 2*BH + 2*M1;
  1424.     cButtons[cbMemStore].Position := Rect(X, Y, X+BW, Y+BH);
  1425.     cButtons[cbMemStore].Caption := GetOrphStr(SCCalcMS);
  1426.  
  1427.     Y := TM + 3*BH + 3*M1;
  1428.     cButtons[cbMemAdd].Position := Rect(X, Y, X+BW, Y+BH);
  1429.     cButtons[cbMemAdd].Caption := GetOrphStr(SCCalcMPlus);
  1430.  
  1431.     Y := TM + 4*BH + 4*M1;
  1432.     cButtons[cbMemSub].Position := Rect(X, Y, X+BW, Y+BH);
  1433.     cButtons[cbMemSub].Caption := GetOrphStr(SCCalcMMinus);
  1434.   end else
  1435.     for B := cbMemClear to cbMemSub do
  1436.       cButtons[B].Visible := False;
  1437.  
  1438.   {row 1 - large buttons}
  1439.   Y := TM;
  1440.   if coShowMemoryButtons in FOptions then
  1441.     if coShowClearTapeButton in FOptions then
  1442.       X := BW + M2 + M4
  1443.     else
  1444.       X := 2*BW + M4 + M2 + M1
  1445.   else
  1446.     if coShowClearTapeButton in FOptions then
  1447.       X := M2
  1448.     else
  1449.       X := BW + M2 + M1;
  1450.  
  1451.   cButtons[cbTape].Position := Rect(X, Y, X+LBW, Y+BH);
  1452.   cButtons[cbTape].Caption := GetOrphStr(SCCalcCT);
  1453.  
  1454.   if coShowClearTapeButton in FOptions then begin
  1455.     cButtons[cbTape].Visible := True;
  1456.     Inc(X, LBW+M1);
  1457.     if ((BW+M1)*5 - (LBW+M1)*4) >= 3 then
  1458.       Inc(X, 1);
  1459.   end else begin
  1460.     cButtons[cbTape].Visible := False;
  1461.   end;
  1462.  
  1463.   cButtons[cbBack].Position := Rect(X, Y, X+LBW, Y+BH);
  1464.   cButtons[cbBack].Caption := GetOrphStr(SCCalcBack);
  1465.  
  1466.   Inc(X, LBW+M1);
  1467.   if coShowClearTapeButton in FOptions then begin
  1468.     if ((BW+M1)*5 - (LBW+M1)*4) >= 2 then
  1469.       Inc(X, 1);
  1470.   end else begin
  1471.     if ((BW+M1)*4 - (LBW+M1)*3) >= 2 then
  1472.       Inc(X, 1);
  1473.   end;
  1474.   cButtons[cbClearEntry].Position := Rect(X, Y, X+LBW, Y+BH);
  1475.   cButtons[cbClearEntry].Caption := GetOrphStr(SCCalcCE);
  1476.  
  1477.   Inc(X, LBW+M1);
  1478.   if coShowClearTapeButton in FOptions then begin
  1479.     if ((BW+M1)*5 - (LBW+M1)*4) >= 1 then
  1480.       Inc(X, 1);
  1481.   end else begin
  1482.     if ((BW+M1)*4 - (LBW+M1)*3) >= 1 then
  1483.       Inc(X, 1);
  1484.   end;
  1485.   cButtons[cbClear].Position := Rect(X, Y, X+LBW, Y+BH);
  1486.   cButtons[cbClear].Caption := GetOrphStr(SCCalcC);
  1487.  
  1488.   {row 2}
  1489.   Y := TM + BH + M1;
  1490.   if coShowMemoryButtons in FOptions then
  1491.     X := M2 + BW + M4
  1492.   else
  1493.     X := M2;
  1494.   cButtons[cb7].Position := Rect(X, Y, X+BW, Y+BH);
  1495.   cButtons[cb7].Caption := '7';
  1496.  
  1497.   Inc(X, BW+M1);
  1498.   cButtons[cb8].Position := Rect(X, Y, X+BW, Y+BH);
  1499.   cButtons[cb8].Caption := '8';
  1500.  
  1501.   Inc(X, BW+M1);
  1502.   cButtons[cb9].Position := Rect(X, Y, X+BW, Y+BH);
  1503.   cButtons[cb9].Caption := '9';
  1504.  
  1505.   Inc(X, BW+M1);
  1506.   cButtons[cbDiv].Position := Rect(X, Y, X+BW, Y+BH);
  1507.   cButtons[cbDiv].Caption := '/';
  1508.  
  1509.   Inc(X, BW+M1);
  1510.   cButtons[cbSqrt].Position := Rect(X, Y, X+BW, Y+BH);
  1511.   cButtons[cbSqrt].Caption := GetOrphStr(SCCalcSqrt);
  1512.  
  1513.   {row 3}
  1514.   Y := TM + 2*BH + 2*M1;
  1515.   if coShowMemoryButtons in FOptions then
  1516.     X := M2 + BW + M4
  1517.   else
  1518.     X := M2;
  1519.   cButtons[cb4].Position := Rect(X, Y, X+BW, Y+BH);
  1520.   cButtons[cb4].Caption := '4';
  1521.  
  1522.   Inc(X, BW+M1);
  1523.   cButtons[cb5].Position := Rect(X, Y, X+BW, Y+BH);
  1524.   cButtons[cb5].Caption := '5';
  1525.  
  1526.   Inc(X, BW+M1);
  1527.   cButtons[cb6].Position := Rect(X, Y, X+BW, Y+BH);
  1528.   cButtons[cb6].Caption := '6';
  1529.  
  1530.   Inc(X, BW+M1);
  1531.   cButtons[cbMul].Position := Rect(X, Y, X+BW, Y+BH);
  1532.   cButtons[cbMul].Caption := '*';
  1533.  
  1534.   Inc(X, BW+M1);
  1535.   cButtons[cbPercent].Position := Rect(X, Y, X+BW, Y+BH);
  1536.   cButtons[cbPercent].Caption := '%';
  1537.  
  1538.   {row 4}
  1539.   Y := TM + 3*BH + 3*M1;
  1540.   if coShowMemoryButtons in FOptions then
  1541.     X := M2 + BW + M4
  1542.   else
  1543.     X := M2;
  1544.   cButtons[cb1].Position := Rect(X, Y, X+BW, Y+BH);
  1545.   cButtons[cb1].Caption := '1';
  1546.  
  1547.   Inc(X, BW+M1);
  1548.   cButtons[cb2].Position := Rect(X, Y, X+BW, Y+BH);
  1549.   cButtons[cb2].Caption := '2';
  1550.  
  1551.   Inc(X, BW+M1);
  1552.   cButtons[cb3].Position := Rect(X, Y, X+BW, Y+BH);
  1553.   cButtons[cb3].Caption := '3';
  1554.  
  1555.   Inc(X, BW+M1);
  1556.   cButtons[cbSub].Position := Rect(X, Y, X+BW, Y+BH);
  1557.   cButtons[cbSub].Caption := '-';
  1558.  
  1559.   Inc(X, BW+M1);
  1560.   cButtons[cbInvert].Position := Rect(X, Y, X+BW, Y+BH);
  1561.   cButtons[cbInvert].Caption := '1/x';
  1562.  
  1563.   {row 5}
  1564.   Y := TM + 4*BH + 4*M1;
  1565.   if coShowMemoryButtons in FOptions then
  1566.     X := M2 + BW + M4
  1567.   else
  1568.     X := M2;
  1569.   cButtons[cb0].Position := Rect(X, Y, X+BW, Y+BH);
  1570.   cButtons[cb0].Caption := '0';
  1571.  
  1572.   Inc(X, BW+M1);
  1573.   cButtons[cbChangeSign].Position := Rect(X, Y, X+BW, Y+BH);
  1574.   cButtons[cbChangeSign].Caption := '+/-';
  1575.  
  1576.   Inc(X, BW+M1);
  1577.   cButtons[cbDecimal].Position := Rect(X, Y, X+BW, Y+BH);
  1578.   cButtons[cbDecimal].Caption := DecimalSeparator;
  1579.  
  1580.   Inc(X, BW+M1);
  1581.   cButtons[cbAdd].Position := Rect(X, Y, X+BW, Y+BH);
  1582.   cButtons[cbAdd].Caption := '+';
  1583.  
  1584.   Inc(X, BW+M1);
  1585.   cButtons[cbEqual].Position := Rect(X, Y, X+BW, Y+BH);
  1586.   cButtons[cbEqual].Caption := '=';
  1587. end;
  1588.  
  1589. procedure TOvcCustomCalculator.cClearAll;
  1590. begin
  1591.   cEngine.ClearAll;
  1592.   DisplayValue := 0;
  1593.   FDisplayStr := '0';
  1594.   cMinus0 := False;
  1595.   cTape.InitializeTape;
  1596.   cPanel.Caption := StringOfChar(' ',
  1597.                        (cTape.TapeDisplaySpace
  1598.                         - Length('0')
  1599.                         - Length(CalcDisplayString[cbNone]))
  1600.                        ) + '0' + '  ';
  1601. end;
  1602.  
  1603. procedure TOvcCustomCalculator.cColorChange(Sender : TObject);
  1604. begin
  1605.   {update panel background color}
  1606.   if Assigned(cPanel) then begin
  1607.     cPanel.Color := FColors.Display;
  1608.     cPanel.Font.Color := FColors.DisplayTextColor;
  1609.     {update the main font color}
  1610.     if not (csLoading in ComponentState) and (Font <> nil) then
  1611.       Font.Color := FColors.DisplayTextColor;
  1612.   end;
  1613.  
  1614.   if Assigned(cTape) then begin
  1615.     cTape.TapeColor := FColors.Display;
  1616.   end;
  1617.  
  1618.   Invalidate;
  1619. end;
  1620.  
  1621. procedure TOvcCustomCalculator.cDisplayError;
  1622. begin
  1623.   cSetDisplayString('****** ');
  1624.   cEngine.State := [csLocked]; {user will have to clear this}
  1625.   MessageBeep(0);
  1626. end;
  1627.  
  1628. procedure TOvcCustomCalculator.cDrawCalcButton(const Button : TOvcButtonInfo; const Pressed : Boolean);
  1629. var
  1630.   TR  : TRect;
  1631.   Buf : array[0..255] of Char;
  1632. begin
  1633.   if Button.Visible then begin
  1634.     TR := DrawButtonFace(Canvas, Button.Position, 1, bsNew, False, Pressed, False);
  1635.     StrPLCopy(Buf, Button.Caption, 255);
  1636.     DrawText(Canvas.Handle, Buf, StrLen(Buf), TR,
  1637.              DT_CENTER or DT_VCENTER or DT_SINGLELINE);
  1638.  
  1639.     if Focused and (Button.Caption = '=') then
  1640.       cDrawFocusState;
  1641.   end;
  1642. end;
  1643.  
  1644. procedure TOvcCustomCalculator.cDrawFocusState;
  1645. var
  1646.   R : TRect;
  1647. begin
  1648.   R := cButtons[cbEqual].Position;
  1649.   InflateRect(R, -3, -3);
  1650.   Canvas.DrawFocusRect(R);
  1651. end;
  1652.  
  1653. procedure TOvcCustomCalculator.cDrawSizeLine;
  1654. var
  1655.   OldPen : TPen;
  1656. begin
  1657.   if (cSizing) then
  1658.     with Canvas do begin
  1659.       OldPen := TPen.Create;
  1660.       try
  1661.         OldPen.Assign(Pen);
  1662.         Pen.Color := clBlack;
  1663.         Pen.Mode := pmXor;
  1664.         Pen.Style := psDot;
  1665.         Pen.Width := 1;
  1666.         MoveTo(0, cSizeOffset);
  1667.         LineTo(ClientWidth, cSizeOffset);
  1668.       finally
  1669.         Canvas.Pen := OldPen;
  1670.         OldPen.Free;
  1671.       end;
  1672.     end;
  1673. end;
  1674.  
  1675. procedure TOvcCustomCalculator.cEvaluate(const Button : TOvcCalculatorButton);
  1676. begin
  1677.   if csValid in cEngine.State then begin
  1678.     try
  1679.       {evaluate the expression}
  1680.       if cEngine.AddOperation(CalcButtontoOperation[Button]) then begin
  1681.         DisplayValue := cEngine.TopOperand;
  1682.         if Button in [cbAdd, cbSub, cbMul, cbDiv, cbEqual, cbPercent, cbNone] then
  1683.           if (Button in [cbAdd, cbSub, cbMul, cbDiv]) and (cLastButton = Button) then
  1684.             cTape.AddToTape(cFormatString(LastOperand), CalcDisplayString[Button])
  1685.           else
  1686.             cTape.AddToTape(FDisplayStr, CalcDisplayString[Button]);
  1687.         if (Button = cbEqual) and (cEngine.LastOperation = coEqual) then begin
  1688.           if coShowItemCount in FOptions then
  1689.             cTape.AddToTapeLeft(Format('%3.3d',[cEngine.OperationCount+1]));
  1690.           cTape.AddToTape(cFormatString(DisplayValue), CalcDisplayString[cbSubTotal]);
  1691.           cTape.SpaceTape(TapeSeparatorChar);
  1692.         end;
  1693.         FDisplayStr := cFormatString(DisplayValue);
  1694.       end;
  1695.     except
  1696.       cDisplayError;
  1697.     end;
  1698.   end;
  1699. end;
  1700.  
  1701. function TOvcCustomCalculator.cFormatString(const Value : Extended) : string;
  1702. begin
  1703.   if cEngine.Decimals = 0 then
  1704.     Result := Format('%g',[Value])
  1705.   else if cEngine.Decimals < 0 then
  1706.     Result := Format('%.*f',[-cEngine.Decimals, Value])
  1707.   else
  1708.     Result := Format('%.*f',[cEngine.Decimals, Value]);
  1709. end;
  1710.  
  1711. function TOvcCustomCalculator.cGetFontWidth : Integer;
  1712. var
  1713.   DC         : hDC;
  1714.   SaveFont   : hFont;
  1715.   Size       : TSize;
  1716. begin
  1717.   if not assigned(cPanel) then begin
  1718.     Result := 8; {Return something resonable }
  1719.     Exit;
  1720.   end;
  1721.   DC := GetDC(0);
  1722.   SaveFont := SelectObject(DC, cPanel.Font.Handle);
  1723.   GetTextExtentPoint(DC, ' 0123456789', 11, Size);
  1724.   Result := Round(Size.cx/11);
  1725.   SelectObject(DC, SaveFont);
  1726.   ReleaseDC(0, DC);
  1727. end;
  1728.  
  1729. procedure TOvcCustomCalculator.cInvalidateIndicator;
  1730. begin
  1731.   InvalidateRect(Handle, @cButtons[cbMemRecall].Position, False);
  1732.   InvalidateRect(Handle, @cButtons[cbMemClear].Position, False);
  1733. end;
  1734.  
  1735. procedure TOvcCustomCalculator.cRefreshDisplays;
  1736. begin
  1737.   if not cPanel.HandleAllocated then
  1738.     Exit;
  1739.  
  1740.   cTape.RefreshDisplays;
  1741.   DisplayValue := DisplayValue;
  1742. end;
  1743.  
  1744. procedure TOvcCustomCalculator.cSetDisplayString(const Value : string);
  1745. var
  1746.   DSpace : Integer;
  1747. begin
  1748.   try
  1749.     if cPanel.HandleAllocated then begin
  1750.       DSpace := cTape.TapeDisplaySpace
  1751.               - Length(Value)
  1752.               - Length(CalcDisplayString[cbNone]);
  1753.       cPanel.Caption := StringOfChar(' ', DSpace) + Value + '  ';
  1754.     end;
  1755.   except
  1756.     cDisplayError;
  1757.   end;
  1758. end;
  1759.  
  1760. procedure TOvcCustomCalculator.cTapeFontChange(Sender : TObject);
  1761. begin
  1762.   cPanel.Font := TapeFont;
  1763. end;
  1764.  
  1765. procedure TOvcCustomCalculator.SetBorderStyle(const Value : TBorderStyle);
  1766. begin
  1767.   if Value <> FBorderStyle then begin
  1768.     FBorderStyle := Value;
  1769.     RecreateWnd;
  1770.   end;
  1771. end;
  1772.  
  1773. function TOvcCustomCalculator.GetDecimals : Integer;
  1774. begin
  1775.   Result := cEngine.Decimals;
  1776. end;
  1777.  
  1778. procedure TOvcCustomCalculator.SetDecimals(const Value : Integer);
  1779. begin
  1780.   if Value <> cEngine.Decimals then begin
  1781.     cEngine.Decimals := Value;
  1782.     ccalculateLook;
  1783.     Invalidate;
  1784.   end;
  1785. end;
  1786.  
  1787. function TOvcCustomCalculator.GetMemory : Extended;
  1788. begin
  1789.   Result := cEngine.Memory;
  1790. end;
  1791.  
  1792. procedure TOvcCustomCalculator.SetMemory(const Value : Extended);
  1793. begin
  1794.   if Value <> cEngine.Memory then begin
  1795.     cEngine.Memory := Value;
  1796.     cCalculateLook;
  1797.     Invalidate;
  1798.   end;
  1799. end;
  1800.  
  1801. procedure TOvcCustomCalculator.SetMaxPaperCount(const Value : Integer);
  1802. begin
  1803.   if Value <> cTape.MaxPaperCount then begin
  1804.     cTape.MaxPaperCount := Value;
  1805.     Invalidate;
  1806.   end;
  1807. end;
  1808.  
  1809. function TOvcCustomCalculator.GetMaxPaperCount : Integer;
  1810. begin
  1811.   Result := cTape.MaxPaperCount;
  1812. end;
  1813.  
  1814. procedure TOvcCustomCalculator.SetOptions(const Value : TOvcCalculatorOptions);
  1815. begin
  1816.   if Value <> FOptions then begin
  1817.     FOptions := Value;
  1818.  
  1819.  
  1820.     cTape.ShowTape := coShowTape in FOptions;
  1821.     cTape.Visible := coShowTape in FOptions;
  1822.     cEngine.ShowSeparatePercent := coShowSeparatePercent in FOptions;
  1823.  
  1824.     cCalculateLook;
  1825.     Invalidate;
  1826.   end;
  1827. end;
  1828.  
  1829. function TOvcCustomCalculator.GetTape : TStrings;
  1830. begin
  1831.   Result := cTape.Tape;
  1832. end;
  1833.  
  1834. procedure TOvcCustomCalculator.SetTape(const Value : TStrings);
  1835. begin
  1836.   cTape.Tape := Value;
  1837. end;
  1838.  
  1839. function TOvcCustomCalculator.GetTapeFont : TFont;
  1840. begin
  1841.   Result := cTape.Font;
  1842. end;
  1843.  
  1844. procedure TOvcCustomCalculator.SetTapeFont(const Value : TFont);
  1845. begin
  1846.   cTape.Font := Value;
  1847. end;
  1848.  
  1849. function TOvcCustomCalculator.GetTapeHeight : Integer;
  1850. begin
  1851.   Result := cTape.Height;
  1852. end;
  1853.  
  1854. procedure TOvcCustomCalculator.SetTapeHeight(const Value : Integer);
  1855. begin
  1856.   cTape.Height := Value;
  1857.   cCalculateLook;
  1858.   Invalidate;
  1859. end;
  1860.  
  1861. function TOvcCustomCalculator.GetVisible : Boolean;
  1862. begin
  1863.   Result := inherited Visible;
  1864. end;
  1865.  
  1866. procedure TOvcCustomCalculator.SetVisible(const Value : Boolean);
  1867. begin
  1868.   inherited Visible := Value;
  1869.  
  1870.   cTape.Visible := cTape.ShowTape;
  1871. end;
  1872.  
  1873. procedure TOvcCustomCalculator.SetDisplay(const Value : Extended);
  1874. var
  1875.   ValueString : string;
  1876. begin
  1877.   try
  1878.     FDisplay := Value;
  1879.     if cPanel.HandleAllocated then begin
  1880.       ValueString := cFormatString(Value);
  1881.       cSetDisplayString(ValueString);
  1882.     end;
  1883.   except
  1884.     cDisplayError;
  1885.   end;
  1886. end;
  1887.  
  1888. procedure TOvcCustomCalculator.SetDisplayStr(const Value : string);
  1889. begin
  1890.   FDisplayStr := Value;
  1891.   while (Length(FDisplayStr) > 0) and (FDisplayStr[1] = ' ') do
  1892.     FDisplayStr := Copy(FDisplayStr, 2, Length(FDisplayStr) - 1);
  1893. end;
  1894.  
  1895. function TOvcCustomCalculator.GetOperand : Extended;
  1896. begin
  1897.   Result := cEngine.TopOperand;
  1898. end;
  1899.  
  1900. procedure TOvcCustomCalculator.SetOperand(const Value : Extended);
  1901. begin
  1902.   if Value = cEngine.TopOperand then
  1903.     Exit;
  1904.   cEngine.PushOperand(Value);
  1905. end;
  1906.  
  1907. procedure TOvcCustomCalculator.CMCtl3DChanged(var Msg : TMessage);
  1908. begin
  1909.   inherited;
  1910.  
  1911.   if (csLoading in ComponentState) or not HandleAllocated then
  1912.     Exit;
  1913.  
  1914.   {$IFDEF Win32}
  1915.   if NewStyleControls and (FBorderStyle = bsSingle) then
  1916.     RecreateWnd;
  1917.   {$ENDIF}
  1918.  
  1919.   Invalidate;
  1920. end;
  1921.  
  1922. procedure TOvcCustomCalculator.CMDesignHitTest(var Msg : TCMDesignHitTest);
  1923. begin
  1924.   Msg.Result := LongInt(cOverBar);
  1925. end;
  1926.  
  1927. procedure TOvcCustomCalculator.CMEnter(var Msg : TMessage);
  1928. var
  1929.   R : TRect;
  1930. begin
  1931.   inherited;
  1932.  
  1933.   {invalidate the "=" button to ensure that the focus rect is painted}
  1934.   R := cButtons[cbEqual].Position;
  1935.   InvalidateRect(Handle, @R, False);
  1936. end;
  1937.  
  1938. procedure TOvcCustomCalculator.CMExit(var Msg : TMessage);
  1939. var
  1940.   R : TRect;
  1941. begin
  1942.   inherited;
  1943.  
  1944.   {invalidate the "=" button to ensure that the focus rect is painted}
  1945.   R := cButtons[cbEqual].Position;
  1946.   InvalidateRect(Handle, @R, False);
  1947. end;
  1948.  
  1949. procedure TOvcCustomCalculator.CMFontChanged(var Msg : TMessage);
  1950. begin
  1951.   inherited;
  1952.  
  1953.   if not (csLoading in ComponentState) and Assigned(cPanel) then begin
  1954.     cPanel.Color := FColors.Display;
  1955.     cPanel.Font.Color := FColors.DisplayTextColor;
  1956.     FColors.FCalcColors[2] := Font.Color;
  1957.   end;
  1958.  
  1959.   cCalculateLook;
  1960.   Invalidate;
  1961. end;
  1962.  
  1963. procedure TOvcCustomCalculator.WMEraseBkgnd(var Msg : TWMEraseBkgnd);
  1964. begin
  1965.   Msg.Result := 1;   {don't erase background, just say we did}
  1966. end;
  1967.  
  1968. procedure TOvcCustomCalculator.WMGetText(var Msg : TWMGetText);
  1969. begin
  1970.   if not cPanel.HandleAllocated then
  1971.     Exit;
  1972.  
  1973.   Msg.Result := SendMessage(cPanel.Handle, WM_GETTEXT,
  1974.     TMessage(Msg).wParam, TMessage(Msg).lParam);
  1975. end;
  1976.  
  1977. procedure TOvcCustomCalculator.WMGetTextLength(var Msg : TWMGetTextLength);
  1978. begin
  1979.   if not cPanel.HandleAllocated then
  1980.     Exit;
  1981.  
  1982.   Msg.Result := SendMessage(cPanel.Handle, WM_GETTEXTLENGTH,
  1983.     TMessage(Msg).wParam, TMessage(Msg).lParam);
  1984. end;
  1985.  
  1986. procedure TOvcCustomCalculator.WMKeyDown(var Msg : TWMKeyDown);
  1987. begin
  1988.   if Msg.CharCode = Ord('M') then begin
  1989.     if (GetAsyncKeyState(VK_CONTROL) and $8000) <> 0 then begin
  1990.       PressButton(cbMemStore);
  1991.     end;
  1992.   end else if Msg.CharCode = VK_RETURN then
  1993.     PressButton(cbEqual);
  1994.  
  1995.   inherited;
  1996. end;
  1997.  
  1998. procedure TOvcCustomCalculator.WMSetText(var Msg : TWMSetText);
  1999. var
  2000.   I : Integer;
  2001.   C : AnsiChar;
  2002. begin
  2003.   cClearAll;
  2004.   for I := 0 to Pred(StrLen(Msg.Text)) do begin
  2005.     C := Msg.Text[I];
  2006.     KeyPress(C);
  2007.   end;
  2008.   Msg.Result := 1{true};
  2009. end;
  2010.  
  2011. procedure TOvcCustomCalculator.WMNCHitTest(var Msg : TWMNCHitTest);
  2012. begin
  2013.   inherited;
  2014.  
  2015.   cHitTest.X := Msg.Pos.X;
  2016.   cHitTest.Y := Msg.Pos.Y;
  2017. end;
  2018.  
  2019. procedure TOvcCustomCalculator.WMSetCursor(var Msg : TWMSetCursor);
  2020. var
  2021.   vHitTest : TPoint;
  2022.  
  2023.   procedure SetNewCursor(C : HCursor);
  2024.   begin
  2025.     SetCursor(C);
  2026.     Msg.Result := Ord(True);
  2027.   end;
  2028.  
  2029. begin
  2030.   if not (coShowTape in FOptions) then
  2031.     Exit;
  2032.  
  2033.   if csDesigning in ComponentState then begin
  2034.     if (Msg.HitTest = HTCLIENT) then begin
  2035.       cOverBar := False;
  2036.       vHitTest := ScreenToClient(cHitTest);
  2037.       if vHitTest.Y > cTape.Top + cTape.Height then
  2038.         if vHitTest.Y < cTape.Top + cTape.Height+4 then
  2039.           cOverBar := True;
  2040.     end;
  2041.  
  2042.     {set appropriate cursor}
  2043.     if cOverBar then
  2044.       SetNewCursor(cTabCursor)
  2045.     else
  2046.       inherited;
  2047.   end else
  2048.     inherited;
  2049. end;
  2050.  
  2051. procedure TOvcCustomCalculator.WMCancelMode(var Msg : TMessage);
  2052. begin
  2053.   inherited;
  2054.  
  2055.   cSizing := False;
  2056. end;
  2057.  
  2058. procedure TOvcCustomCalculator.WMKillFocus(var Msg : TWMKillFocus);
  2059. begin
  2060.   inherited;
  2061.  
  2062.   Invalidate;
  2063. end;
  2064.  
  2065. procedure TOvcCustomCalculator.WMLButtonDown(var Msg : TWMMouse);
  2066. begin
  2067.   inherited;
  2068.  
  2069.   {are we currently showing a sizing cursor? if so the user wants to
  2070.    resize a column/row}
  2071.   if (cOverBar) then begin
  2072.     cSizeOffset := Msg.YPos;
  2073.     cSizing := True;
  2074.     cDrawSizeLine;
  2075.   end;
  2076. end;
  2077.  
  2078. procedure TOvcCustomCalculator.WMLButtonUp(var Msg : TWMMouse);
  2079. var
  2080.   Form : TForm;
  2081. begin
  2082.   inherited;
  2083.  
  2084.   if (cSizing) then begin
  2085.     cDrawSizeLine;
  2086.     cSizing := False;
  2087.     cTape.Height := cSizeOffset - 8;
  2088.     cCalculateLook;
  2089.  
  2090.     Refresh;
  2091.     if (csDesigning in ComponentState) then begin
  2092.       Form := TForm(GetParentForm(Self));
  2093.       if (Form <> nil) and (Form.Designer <> nil) then
  2094.         Form.Designer.Modified;
  2095.     end;
  2096.   end;
  2097. end;
  2098.  
  2099. procedure TOvcCustomCalculator.WMMouseMove(var Msg : TWMMouse);
  2100. begin
  2101.   inherited;
  2102.  
  2103.   if (cSizing) then begin
  2104.     cDrawSizeLine;
  2105.     if Msg.YPos >= calcDefMinSize + cTape.Top then
  2106.       if Msg.YPos <= Height - calcDefMinSize then
  2107.         cSizeOffset := Msg.YPos + 2
  2108.       else
  2109.         cSizeOffset := Height - calcDefMinSize
  2110.     else
  2111.       cSizeOffset := calcDefMinSize + cTape.Top;
  2112.     cDrawSizeLine;
  2113.   end;
  2114. end;
  2115.  
  2116. procedure TOvcCustomCalculator.CopyToClipboard;
  2117. begin
  2118.   Clipboard.AsText := Text;
  2119. end;
  2120.  
  2121. constructor TOvcCustomCalculator.Create(AOwner : TComponent);
  2122. begin
  2123.   inherited Create(AOwner);
  2124.  
  2125.   if cPopup then
  2126.     ControlStyle           := ControlStyle + [csClickEvents, csFramed] - [csCaptureMouse]
  2127.   else
  2128.     ControlStyle           := ControlStyle + [csClickEvents, csFramed, csCaptureMouse];
  2129.  
  2130.   Color                    := clBtnFace;
  2131.   TabStop                  := True;
  2132.   Width                    := 200;
  2133.   Font.Name                := 'MS Sans Serif';
  2134.   Font.Size                := 8;
  2135.   Font.Style               := [];
  2136.   cDecimalEntered          := False;
  2137.   cSizing                  := False;
  2138.   cScrBarWidth             := 18;
  2139.  
  2140.   {create edit control}
  2141.   cPanel                   := TOvcCalcPanel.Create(Self);
  2142.   cPanel.Parent            := Self;
  2143.   cPanel.ParentFont        := False;
  2144.   cPanel.Font.Name         := 'Courier New';
  2145.   cPanel.Font.Size         := 10;
  2146.   cPanel.Font.Style        := [];
  2147.   cPanel.ParentCtl3D       := True;
  2148.   cPanel.Alignment         := taLeftJustify;
  2149.   cPanel.BevelOuter        := bvLowered;
  2150.   cPanel.BorderStyle       := bsNone;
  2151.   cPanel.Color             := clWindow;
  2152.   cPanel.BevelWidth        := 2;
  2153.   cPanel.Caption           := '0 ';
  2154.  
  2155.   {set property defaults}
  2156.   {$IFDEF Win32}
  2157.   FBorderStyle             := bsNone;
  2158.   Height                   := 140;
  2159.   {$ELSE}
  2160.   FBorderStyle             := bsSingle;
  2161.   Height                   := 160;
  2162.   {$ENDIF Win32}
  2163.   FTapeSeparatorChar       := '_';
  2164.  
  2165.   FOptions                 := [coShowMemoryButtons, coShowItemCount];
  2166.  
  2167.   FColors                  := TOvcCalcColors.Create;
  2168.   FColors.OnChange         := cColorChange;
  2169.  
  2170.   {assign default color scheme}
  2171.   FColors.FCalcColors      := CalcScheme[cscalcWindows];
  2172.  
  2173.   {create tape}
  2174.   cTape := TOvcCalcTape.Create(Self, Length(CalcDisplayString[cbNone]));
  2175.   cTape.ShowTape           := False;
  2176.   cTape.TapeColor          := clWindow;
  2177.   cTape.MaxPaperCount      := 9999;
  2178.   TapeHeight               := Height div 3;
  2179.   TapeFont.OnChange        := cTapeFontChange;
  2180.   TapeFont.Name            := 'Courier New';
  2181.   TapeFont.Size            := 10;
  2182.   TapeFont.Style           := [];
  2183.   cTape.Visible            := cTape.ShowTape;
  2184.  
  2185.   cEngine := TOvcBasicCalculatorEngine.Create;
  2186.   cEngine.Decimals         := 2;
  2187.   cEngine.ShowSeparatePercent := False;
  2188.  
  2189.   if csDesigning in ComponentState then
  2190.     cTabCursor := Screen.Cursors[crVSplit];
  2191. end;
  2192.  
  2193. constructor TOvcCustomCalculator.CreateEx(AOwner : TComponent; AsPopup : Boolean);
  2194. begin
  2195.   cPopup := AsPopup;
  2196.   Create(AOwner);
  2197. end;
  2198.  
  2199. procedure TOvcCustomCalculator.CreateParams(var Params : TCreateParams);
  2200. const
  2201.   BorderStyles : array[TBorderStyle] of LongInt = (0, WS_BORDER);
  2202. begin
  2203.   inherited CreateParams(Params);
  2204.  
  2205.   with Params do begin
  2206.     Style := LongInt(Style) or BorderStyles[FBorderStyle];
  2207.     if cPopup then begin
  2208.       Style := WS_POPUP or WS_BORDER;
  2209.       WindowClass.Style := WindowClass.Style or CS_SAVEBITS;
  2210.     end;
  2211.   end;
  2212.  
  2213.   {$IFDEF Win32}
  2214.   if NewStyleControls and (Ctl3D or cPopup) and (FBorderStyle = bsSingle) then begin
  2215.     if not cPopup then
  2216.       Params.Style := Params.Style and not WS_BORDER;
  2217.     Params.ExStyle := Params.ExStyle or WS_EX_CLIENTEDGE;
  2218.   end;
  2219.   {$ENDIF}
  2220. end;
  2221.  
  2222. procedure TOvcCustomCalculator.CreateWnd;
  2223. begin
  2224.   inherited CreateWnd;
  2225.  
  2226.   cCalculateLook;
  2227.   cClearAll;
  2228.  
  2229.   cPanel.Color := FColors.Display;
  2230. end;
  2231.  
  2232. destructor TOvcCustomCalculator.Destroy;
  2233. begin
  2234.   cTape.Free;
  2235.   cTape := nil;
  2236.  
  2237.   cEngine.Free;
  2238.   cEngine := nil;
  2239.  
  2240.   FColors.Free;
  2241.   FColors := nil;
  2242.  
  2243.   cTabCursor := 0;
  2244.  
  2245.   inherited Destroy;
  2246. end;
  2247.  
  2248. procedure TOvcCustomCalculator.KeyDown(var Key : Word; Shift : TShiftState);
  2249. begin
  2250.   inherited KeyDown(Key, Shift);
  2251.  
  2252.   case Key of
  2253.     VK_DELETE : if Shift = [] then
  2254.                   PressButton(cbClearEntry);
  2255.     VK_F9     : if Shift = [] then
  2256.                   PressButton(cbChangeSign);
  2257.   end;
  2258. end;
  2259.  
  2260. procedure TOvcCustomCalculator.KeyPress(var Key : Char);
  2261. begin
  2262.   inherited KeyPress(Key);
  2263.  
  2264.   case Key of
  2265.     '0' : PressButton(cb0);
  2266.     '1' : PressButton(cb1);
  2267.     '2' : PressButton(cb2);
  2268.     '3' : PressButton(cb3);
  2269.     '4' : PressButton(cb4);
  2270.     '5' : PressButton(cb5);
  2271.     '6' : PressButton(cb6);
  2272.     '7' : PressButton(cb7);
  2273.     '8' : PressButton(cb8);
  2274.     '9' : PressButton(cb9);
  2275.  
  2276.     '+' : PressButton(cbAdd);
  2277.     '-' : PressButton(cbSub);
  2278.     '*' : PressButton(cbMul);
  2279.     '/' : PressButton(cbDiv);
  2280.  
  2281.     '.' : PressButton(cbDecimal);
  2282.     '=' : PressButton(cbEqual);
  2283.     'r' : PressButton(cbInvert);
  2284.     '%' : PressButton(cbPercent);
  2285.     '@' : PressButton(cbSqrt);
  2286.  
  2287.     ^L  : PressButton(cbMemClear);  {^L}
  2288.     ^R  : PressButton(cbMemRecall); {^R}
  2289.     ^P  : PressButton(cbMemAdd);    {^P}
  2290.     ^S  : PressButton(cbMemSub);    {^S}
  2291.     ^T  : PressButton(cbTape);      {^T}
  2292.  
  2293.     ^C  : CopyToClipboard;          {^C}{copy}
  2294.     ^V  : PasteFromClipboard;       {^V}{paste}
  2295.  
  2296.     #8  : PressButton(cbBack);      {backspace}
  2297.     #27 : PressButton(cbClear);     {esc}
  2298.   else
  2299.     if Key = DecimalSeparator then
  2300.       PressButton(cbDecimal);
  2301.   end;
  2302. end;
  2303.  
  2304. procedure TOvcCustomCalculator.MouseDown(Button : TMouseButton; Shift : TShiftState; X, Y : Integer);
  2305. var
  2306.   B : TOvcCalculatorButton;
  2307. begin
  2308.   SetFocus;
  2309.  
  2310.   if Button = mbLeft then begin
  2311.     cDownButton := cbNone;
  2312.     for B := Low(cButtons) to High(cButtons) do
  2313.       if cButtons[B].Visible and PtInRect(cButtons[B].Position, Point(X,Y)) then begin
  2314.         if (B in [cbMemClear, cbMemRecall]) and (cEngine.Memory = 0) then
  2315.           Exit;
  2316.         cDownButton := B;
  2317.         InvalidateRect(Handle, @cButtons[cDownButton].Position, False);
  2318.         Break;
  2319.       end;
  2320.   end;
  2321.  
  2322.   inherited MouseDown(Button, Shift, X, Y);
  2323. end;
  2324.  
  2325. procedure TOvcCustomCalculator.MouseUp(Button : TMouseButton; Shift : TShiftState; X, Y : Integer);
  2326. begin
  2327.   if cDownButton = cbNone then
  2328.     Exit;
  2329.  
  2330.   InvalidateRect(Handle, @cButtons[cDownButton].Position, False);
  2331.  
  2332.   {if still over the button...}
  2333.   if PtInRect(cButtons[cDownButton].Position, Point(X,Y)) then
  2334.     PressButton(cDownButton);
  2335.  
  2336.   cDownButton := cbNone;
  2337.  
  2338.   inherited MouseUp(Button, Shift, X, Y);
  2339. end;
  2340.  
  2341. procedure TOvcCustomCalculator.PasteFromClipboard;
  2342. var
  2343.   I : Integer;
  2344.   C : AnsiChar;
  2345.   S : string;
  2346. begin
  2347.   S := Clipboard.AsText;
  2348.   if S > '' then begin
  2349.     cClearAll;
  2350.     for I := 1 to Length(S) do begin
  2351.       C := S[I];
  2352.       if (C in ['0'..'9', DecimalSeparator, '.', '+', '-', '*', '/', '=', '%']) then
  2353.         KeyPress(C);
  2354.     end;
  2355.   end;
  2356. end;
  2357.  
  2358. procedure TOvcCustomCalculator.PressButton(Button : TOvcCalculatorButton);
  2359.  
  2360.   procedure Initialize;
  2361.   begin
  2362.     if (cLastButton <> cbClear) and (Button = cbClear) then begin
  2363.       cClearAll;
  2364.       cTape.SpaceTape(TapeSeparatorChar);
  2365.     end;
  2366.  
  2367.     if (csLocked in cEngine.State) then begin
  2368.       MessageBeep(0);
  2369.       Exit;
  2370.     end;
  2371.  
  2372.     {this logic is here to make cbEqual clear all the second time}
  2373.     if (cLastButton in [cbEqual, cbClear, cbNone]) and (Button = cbEqual) then begin
  2374.       Button := cbClear;
  2375.       cClearAll;
  2376.     end;
  2377.  
  2378.     if (cLastButton = cbPercent) and (Button in [cbAdd, cbSub, cbMul, cbDiv, cbEqual]) then
  2379.       cEvaluate(Button)
  2380.     else if (
  2381.               (
  2382.                 (cLastButton = cbEqual) and
  2383.                 (Button in [cbAdd, cbSub, cbMul, cbDiv])
  2384.               )
  2385.             ) and cEngine.AddOperand(StrToFloat(FDisplayStr), CalcButtontoOperation[Button]) then begin
  2386.       cEvaluate(Button);
  2387.     end
  2388.  
  2389.     else if cEngine.AddOperand(LastOperand, CalcButtontoOperation[Button]) then begin
  2390.       cEvaluate(Button);
  2391.  
  2392.       {remove special operations from stack}
  2393.       if Button in [cbInvert, cbSqrt] then
  2394.         LastOperand := cEngine.PopOperand;
  2395.     end;
  2396.   end;
  2397.  
  2398.   procedure NumberButton;
  2399.   var
  2400.     D    : Extended;
  2401.     DP   : Integer;
  2402.   begin
  2403.     begin
  2404.       if cEngine.LastOperation = coEqual then begin
  2405.         {clear pending operations if last command was =}
  2406.         cClearAll;
  2407.       end;
  2408.  
  2409.       if csClear in cEngine.State then begin
  2410.         if (Decimals < 0) then begin
  2411.           FDisplayStr := '0.' + StringOfChar('0', -Decimals);
  2412.         end else begin
  2413.           FDisplayStr := '';
  2414.           cDecimalEntered := False;
  2415.         end;
  2416.       end;
  2417.  
  2418.       FDisplayStr := FDisplayStr + cButtons[Button].Caption[1];
  2419.       if cMinus0 then begin
  2420.         FDisplayStr := '-' + FDisplayStr;
  2421.         cMinus0 := False;
  2422.       end;
  2423.  
  2424.       if (Decimals < 0) and not cDecimalEntered then begin
  2425.         if Pos(DecimalSeparator, FDisplayStr) > 0 then begin
  2426.           DP := Pos(DecimalSeparator, FDisplayStr);
  2427.           if FDisplayStr[1] = '0' then
  2428.             FDisplayStr := Copy(FDisplayStr,2,DP-2) +
  2429.                            Copy(FDisplayStr,DP+1,1) +
  2430.                            DecimalSeparator +
  2431.                            Copy(FDisplayStr,DP+2,Length(FDisplayStr) - DP)
  2432.           else
  2433.             FDisplayStr := Copy(FDisplayStr,1,DP-1) +
  2434.                            Copy(FDisplayStr,DP+1,1) +
  2435.                            DecimalSeparator +
  2436.                            Copy(FDisplayStr,DP+2,Length(FDisplayStr) - DP);
  2437.         end;
  2438.       end;
  2439.       D := StrToFloat(FDisplayStr);
  2440.       LastOperand := D;
  2441.       if (D <> 0) or
  2442.          (Pos(DecimalSeparator, FDisplayStr) > 0) then begin
  2443.         DisplayValue := D;
  2444.         cSetDisplayString(FDisplayStr);
  2445.         cEngine.State := [csValid];
  2446.       end else begin
  2447.         FDisplayStr := '0';
  2448.         DisplayValue := D;
  2449.         cEngine.State := [csValid, csClear];
  2450.       end;
  2451.     end;
  2452.   end;
  2453.  
  2454.   procedure DecimalButton;
  2455.   var
  2456.     D    : Extended;
  2457.   begin
  2458.     {check if there is already a decimal separator in the string}
  2459.     if Pos(DecimalSeparator, FDisplayStr) = 0 then begin
  2460.       FDisplayStr := FDisplayStr + DecimalSeparator;
  2461.       D := StrToFloat(FDisplayStr);
  2462.       cSetDisplayString(FDisplayStr);
  2463.       LastOperand := D;
  2464.       cEngine.State := [csValid];
  2465.       cDecimalEntered := True;
  2466.     end;
  2467.   end;
  2468.  
  2469.   procedure BackButton;
  2470.   var
  2471.     D    : Extended;
  2472.     DP   : Integer;
  2473.     SaveSign : string;
  2474.   begin
  2475.     D := StrToFloat(FDisplayStr);
  2476.     if D <> 0 then begin
  2477.       if Length(FDisplayStr) > 1 then begin
  2478.         if (Decimals < 0) and not cDecimalEntered then begin
  2479.           if Pos(DecimalSeparator, FDisplayStr) > 0 then begin
  2480.             if FDisplayStr[1] = '-' then begin
  2481.               SaveSign :='-';
  2482.               FDisplayStr := Copy(FDisplayStr,2,Length(FDisplayStr)-1);
  2483.             end else begin
  2484.               SaveSign :='';
  2485.             end;
  2486.             DP := Pos(DecimalSeparator, FDisplayStr);
  2487.             FDisplayStr := '0' + Copy(FDisplayStr,1,DP-2) +
  2488.                            DecimalSeparator +
  2489.                            Copy(FDisplayStr,DP-1,1) +
  2490.                            Copy(FDisplayStr,DP+1,Length(FDisplayStr) - DP);
  2491.             if (FDisplayStr[1] = '0') and (FDisplayStr[2] <> '.') then
  2492.               FDisplayStr := Copy(FDisplayStr,2,Length(FDisplayStr)-1);
  2493.             FDisplayStr := SaveSign + FDisplayStr;
  2494.           end;
  2495.         end;
  2496.         FDisplayStr := Copy(FDisplayStr, 1, Length(FDisplayStr)-1);
  2497.         LastOperand := StrToFloat(FDisplayStr);
  2498.         cSetDisplayString(FDisplayStr);
  2499.       end else begin
  2500.         LastOperand := 0;
  2501.         cMinus0 := False;
  2502.         DisplayValue := LastOperand;
  2503.         cEngine.State := [csValid, csClear];
  2504.       end;
  2505.     end;
  2506.   end;
  2507.  
  2508.   procedure ClearEntryButton;
  2509.   begin
  2510.     begin
  2511.       FDisplayStr := '';
  2512.       LastOperand := 0;
  2513.       cMinus0 := False;
  2514.       DisplayValue := LastOperand;
  2515.     end;
  2516.   end;
  2517.  
  2518.   procedure ChangeSignButton;
  2519.   begin
  2520.     if Length(FDisplayStr) > 0 then begin
  2521.       if FDisplayStr[1] <> '-' then begin
  2522.         FDisplayStr := '-' + FDisplayStr;
  2523.         LastOperand := StrToFloat(FDisplayStr);
  2524.         cSetDisplayString(FDisplayStr);
  2525.       end else begin
  2526.         FDisplayStr := Copy(FDisplayStr, 2, Length(FDisplayStr)-1);
  2527.         LastOperand := StrToFloat(FDisplayStr);
  2528.         cSetDisplayString(FDisplayStr);
  2529.       end;
  2530.       DisplayValue := LastOperand;
  2531.     end else begin
  2532.       LastOperand := 0;
  2533.       cMinus0 := not cMinus0;
  2534.       DisplayValue := LastOperand;
  2535.       if cMinus0 then
  2536.         FDisplayStr := '-';
  2537.       cEngine.State := [csValid, csClear];
  2538.     end;
  2539.   end;
  2540.  
  2541.   procedure ClearTapeButton;
  2542.   var
  2543.     I : Integer;
  2544.   begin
  2545.     with Tape do begin
  2546.       for I := 0 to Count - 1 do begin
  2547.         Strings[I] := '';
  2548.       end;
  2549.       cTape.RefreshDisplays;
  2550.     end;
  2551.   end;
  2552.  
  2553. begin
  2554.   if not HandleAllocated then
  2555.     Exit;
  2556.  
  2557.   {simulate a button down if needed}
  2558.   if cDownButton = cbNone then begin
  2559.     cDownButton := Button;
  2560.     InvalidateRect(Handle, @cButtons[cDownButton].Position, False);
  2561.     Update;
  2562.   end;
  2563.  
  2564.   try try
  2565.     Initialize;
  2566.     case Button of
  2567.       cb0..cb9     : NumberButton;
  2568.       cbDecimal    : DecimalButton;
  2569.       cbBack       : BackButton;
  2570.       cbClearEntry : ClearEntryButton;
  2571.       cbMemStore,
  2572.       cbMemClear,
  2573.       cbMemAdd,
  2574.       cbMemSub     : cInvalidateIndicator;
  2575.       cbChangeSign : ChangeSignButton;
  2576.       cbTape       : ClearTapeButton;
  2577.       cbSqrt,
  2578.       cbInvert     : {};
  2579.     end;
  2580.   except
  2581.     cDisplayError;
  2582.   end;
  2583.   finally
  2584.     {simulate a button up, if the mouse button is up or we aren't focused}
  2585.     if not Focused or (GetAsyncKeyState(GetLeftButton) and $8000 = 0) then begin
  2586.       InvalidateRect(Handle, @cButtons[cDownButton].Position, False);
  2587.       cDownButton := cbNone;
  2588.       Update;
  2589.     end;
  2590.   end;
  2591.  
  2592.   cLastButton := Button;
  2593.   if Assigned(FOnButtonPressed) then
  2594.     FOnButtonPressed(Self, Button);
  2595. end;
  2596.  
  2597. procedure TOvcCustomCalculator.PushOperand(const Value : Extended);
  2598. begin
  2599.   cEngine.PushOperand(Value);
  2600.   LastOperand := Value;
  2601.   DisplayValue := Value;
  2602. end;
  2603.  
  2604. procedure TOvcCustomCalculator.Paint;
  2605. var
  2606.   B  : TOvcCalculatorButton;
  2607. begin
  2608.   Canvas.Font := Font;
  2609.   Canvas.Brush.Color := clBtnFace;
  2610.   Canvas.FillRect(ClientRect);
  2611.  
  2612.   if Ctl3D then begin
  2613.     cPanel.BevelOuter := bvLowered;
  2614.     cPanel.BorderStyle := bsNone;
  2615.   end else begin
  2616.     cPanel.BevelOuter := bvNone;
  2617.   cPanel.BorderStyle := bsSingle;
  2618.   end;
  2619.  
  2620.   {draw buttons}
  2621.   for B := Low(cButtons) to High(cButtons) do begin
  2622.     if (B in [cbMemClear, cbMemRecall, cbMemStore, cbMemAdd, cbMemSub]) then begin
  2623.       if (B in [cbMemClear, cbMemRecall]) and (cEngine.Memory = 0) then
  2624.         Canvas.Font.Color := FColors.DisabledMemoryButtons
  2625.       else
  2626.         Canvas.Font.Color := FColors.MemoryButtons;
  2627.     end else if (B in [cbBack, cbClearEntry, cbClear, cbTape]) then
  2628.       Canvas.Font.Color := FColors.EditButtons
  2629.     else if (B in [cbAdd, cbSub, cbMul, cbDiv, cbEqual]) then
  2630.       Canvas.Font.Color := FColors.OperatorButtons
  2631.     else if (B in [cb0..cb9, cbDecimal]) then
  2632.       Canvas.Font.Color := FColors.NumberButtons
  2633.     else if (B in [cbInvert, cbChangeSign, cbPercent, cbSqrt]) then
  2634.       Canvas.Font.Color := FColors.FunctionButtons;
  2635.  
  2636.     cDrawCalcButton(cButtons[B], (B = cDownButton));
  2637.   end;
  2638. end;
  2639.  
  2640. procedure TOvcCustomCalculator.SetBounds(ALeft, ATop, AWidth, AHeight : Integer);
  2641. begin
  2642.   if Height <> AHeight then
  2643.     if coShowTape in FOptions then
  2644.       if Top <> ATop then begin
  2645.         if TapeHeight + (AHeight - Height) > calcDefMinSize then begin
  2646.           TapeHeight := TapeHeight + (AHeight - Height);
  2647.         end else begin
  2648.           TapeHeight := calcDefMinSize;
  2649.         end
  2650.       end;
  2651.  
  2652.   inherited Setbounds(ALeft, ATop, AWidth, AHeight);
  2653.  
  2654.   cCalculateLook;
  2655. end;
  2656.  
  2657.  
  2658. end.